in reply to Re: a full-featured control for uploading files
in thread a full-featured control for uploading files and a couple other tidbits

Hello again, Datz_cozee75,

For user input with timeout, you can use the Prompt::Timeout module:

use Prompt::Timeout; use constant TIMEOUT => 5; ... if (defined($size_remote)) { my $default = ($size_remote == $size_local) ? 'N' : 'Y'; my $answer = prompt('Overwrite?', $default, TIMEOUT); upload($_) if $answer =~ /^Y/i; # overwrite } else { upload($_); }

Notes:

Two additional observations:

  1. The loop condition:

    while (defined ($_ = readdir($eh)))

    can be written more concisely as:

    while (readdir($eh))
  2. It’s inefficient to use captures in a regex if those captures aren’t needed. Use grouping (non-capturing) parentheses:

    my $pattern = join '|', map "(?:$_)", @filetypes;

    or, in this case, omit the parentheses altogether:

    my $pattern = join '|', @filetypes; ... while (readdir($eh)) { next if /~$/ || -d || !/$pattern/i; ...

Hope that helps,

Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

Replies are listed 'Best First'.
Re^3: a full-featured control for uploading files
by Aldebaran (Curate) on May 26, 2015 at 07:59 UTC

    Thanks so much, Athanasius, this is shaping up really nicely now. The queries are cadenced well and have a nice aesthetic about them as they all align, much like a cpan installation. This is typical output:

    ... value for stairs.jpg is 99199 size remote for stairs.jpg is 99199 Overwrite? [N] :N value for stairs.webm is 30127462 size query undef for stairs.webm stairs.webm doesn't exist 1 uploading stairs.webm ftp return was stairs.webm ...

    I couldn't understand for a while why the first binary was alway being re-uploaded, so I turned up the debug level on Net::FTP and found my answer:

    value for kitchen.m4v is 19297258 Net::FTP=GLOB(0x98127b4)>>> HELP SIZE Net::FTP=GLOB(0x98127b4)<<< 214 Syntax: SIZE <sp> pathname Net::FTP=GLOB(0x98127b4)>>> SIZE kitchen.m4v Net::FTP=GLOB(0x98127b4)<<< 550 SIZE not allowed in ASCII mode size query undef for kitchen.m4v kitchen.m4v doesn't exist Net::FTP=GLOB(0x98127b4)>>> CWD /pages/eh5v.files Net::FTP=GLOB(0x98127b4)<<< 250 CWD command successful Net::FTP=GLOB(0x98127b4)>>> TYPE I Net::FTP=GLOB(0x98127b4)<<< 200 Type set to I 1 uploading kitchen.m4v

    Here's what I have now, with upload() doing 4 different batches of ftp'ing of differing sets of files to different places.

    sub upload { use strict; use warnings; use 5.010; use Net::FTP; use Path::Class; use Prompt::Timeout; use constant TIMEOUT => 5; my ( $rvars, $rftp ) = @_; my %vars = %$rvars; # prelims for server...see if we're able to do anything my $target = "/pages/eh5v.files"; $rftp->binary or die "binary failed$!\n"; #necessary for size req +uest $rftp->cwd($target) or warn "cwd failed in main $!\n"; my $rlist = $rftp->ls(); say "remote list is @$rlist"; # filter binaries for filetypes my @filetypes = qw/jpg jpeg png ogv mp4 m4v webm/; my $pattern = join '|', @filetypes; opendir my $eh, $vars{"to_vids"} or warn "can't open vids $!\n"; while ( readdir($eh) ) { next if /~$/ || -d || !/$pattern/i; my $full_path = file( $vars{"to_vids"}, $_ ); my $string_path = $full_path->stringify; my $size_local = -s $string_path; say "value for $_ is $size_local"; #find size on server my $size_remote = $rftp->size($_) or warn "size query undef for $_ +\n"; if ( defined($size_remote) ) { say "size remote for $_ is $size_ +remote" } else { say "$_ doesn't exist" } ## control for upload cases if ( defined($size_remote) ) { my $default = ( $size_remote == $size_local ) ? 'N' : 'Y'; my $answer = prompt( 'Overwrite?', $default, TIMEOUT ); ftp_binary( $string_path, $_, $rftp, $target ) if $answer =~ /^Y/i; # overwrite } else { ftp_binary( $string_path, $_, $rftp, $target ); } } closedir $eh; # make new directory for page's specific images my $path5 = dir( "", "images", $vars{remote_dir} ); my $string_path5 = $path5->stringify; say "string path5 is $string_path5"; my $mk_return = $rftp->mkdir($string_path5) or warn "mkdir failed in upload $!\n"; say "mk_return is $mk_return"; ######### this part is clunky my $refc = $vars{"ref_content"}; my @AoA = @$refc; for my $i ( 0 .. $#AoA ) { my $a = file( $vars{to_images}, $AoA[$i][0] ); my $sa = $a->stringify; my $b = file( $AoA[$i][0] ); my $sb = $b->stringify; ftp_binary( $sa, $sb, $rftp, $string_path5 ); } #load css file to server my $path3 = file( $vars{"template_path"}, $vars{"css_file"} ); my $string_path3 = $path3->stringify; my $css_return = ftp_ascii( $string_path3, $vars{"css_file"}, $rftp, + "/css" ) or warn "put failed $@\n"; say "css return was $css_return"; #load html file to server my $path4 = file( $vars{"base_path"}, $vars{"html_file"} ); my $string_html = $path4->stringify; my $html_return = ftp_ascii( $string_html, $vars{"html_file"}, $rftp, "/pages" ) or warn "put failed $@\n"; return $html_return; }

    And here are the routines that do the actual ftp'ing:

    sub ftp_binary { use strict; use warnings; use 5.010; use Net::FTP; my ( $from, $to, $rftp, $whereto ) = @_; my $cwd_return = $rftp->cwd($whereto) or die "cwd failed to $whereto + $!\n"; $rftp->binary or die "binary failed$!\n"; say "$cwd_return uploading $to"; my $ftp_return = $rftp->put( $from, $to ) or warn "put failed for $t +o $@\n"; say "ftp return was $ftp_return"; return $ftp_return; } sub ftp_ascii { use strict; use warnings; use 5.010; use Net::FTP; my ( $from, $to, $rftp, $whereto ) = @_; my $cwd_return = $rftp->cwd($whereto) or die "cwd failed to $whereto + $!\n"; $rftp->ascii or die "ascii failed$!\n"; say "$cwd_return uploading $to"; my $ftp_return = $rftp->put( $from, $to ) or warn "put failed for $t +o $@\n"; say "ftp return was $ftp_return"; return $ftp_return; }

    This works, in that it works under best conditions, so I'm still fishing for what I would do if, say, the server didn't respond for a while. I'll be able to post return values when that does happen, and it happens a lot, for whatever reason. I wanted to get this posted for code review. I appreciate any suggestions. Thanks again, Athanasius.