Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re^2: rename files

by flieckster (Scribe)
on Feb 02, 2018 at 20:16 UTC ( #1208352=note: print w/replies, xml ) Need Help??


in reply to Re: rename files
in thread rename files

sorry i should have shown the entire thing. i was hiding the top half because there was info i didn't want to share
#!/usr/bin/perl -w use Net::FTP; use File::Copy; use Net::SMTP; use File::Basename; use Email::Send::SMTP::Gmail; use File::Rename; use POSIX qw(strftime); my $date = strftime("%m-%d-%y",localtime); my $time = strftime("%I:%M:%S",localtime); ###############define all the folders in this game############## my $whitefiles = "/Users/flieckb/Desktop/aero_2push_white/"; my $tiff = "/Users/flieckb/Desktop/aero_tiff/"; my $mybadmatch="_white.tif"; my $dllist='bflieck@industrialcolor.com'; ################################################################ my $current = "$date"; chomp $current; chomp $date; sub mail{ our($mail,$error)=Email::Send::SMTP::Gmail->new( -smtp=>'smtp.gmail.co +m', -login=>'XXXXXX', -pass=>'XXXX', -port=> '25', -debug=> 1, -timeout=> 1000); $mail->send(-to=>"$to", -from=>"$from", -subject=>"$subject", -body=>" +$body", -contenttype=>"text/html"); $mail->bye; } my $mybadmatch="_white.tif"; chdir( $tiff ) or mail ($to = $dllist, $from = $dllist, $subject= "can + not move $file", $body ="can not move $file" ); (@tiff_list) = glob "*tif"; my $upload_count = @tiff_list; foreach my $file (@tiff_list) { if ($file =~ m/$mybadmatch/is) { print "$file is white background match\n"; my $old = "$tiff$file"; my $new = "$whitefiles"; copy ($old, $new) or mail ($to = $dllist, $from = $dllist, $subject= " +can not move $file", $body ="can not move $file" ); open FILE, '>> /Users/flieckb/Desktop/whitefiles.txt' or warn $!; print FILE "$date\t$file\t"; print FILE "\n"; } else { print "$file :normal production image\n"; } } close FILE; chdir( $whitefiles ) or mail ($to = $dllist, $from = $dllist, $subject += "can not get to $whitefiles", $body ="can not get to $whitefiles") +; (@white_list) = glob "*tif"; foreach $file (@white_list) { my $oldfile = $file; # s/.* //g; rename($oldfile, $file); }

Replies are listed 'Best First'.
Re^3: rename files
by poj (Abbot) on Feb 02, 2018 at 20:38 UTC

    Adapt as required

    #!/usr/bin/perl use strict; use warnings; use Time::Piece; use File::Copy; my $path = '/Users/flieckb/Desktop/'; my $logfile = $path.'whitefiles.txt'; my $tiff = $path.'aero_tiff/'; my $whitefiles = $path.'aero_2push_white/'; my $mybadmatch = '_white.tif'; my $date = localtime->ymd; unless (-d $tiff){ die "$tiff does not exist"; } unless (-d $whitefiles){ die "$whitefiles does not exist"; } chdir( $tiff ) or die "$!"; my @tiff_list = glob "*tif"; my $upload_count = @tiff_list; open FILE, '>>', $logfile or die "Could not open $logfile : $!"; foreach my $file (@tiff_list) { if ( $file =~ /$mybadmatch/i ){ print "$file is white background match\n"; my $old = $tiff.$file; print "Copying $old to $whitefiles\n"; copy($old, $whitefiles) or warn "$!"; print FILE "$date\t$file\t\n"; } else { print "$file :normal production image\n"; } } close FILE; chdir( $whitefiles ) or die "$!"; my @white_list = glob "*tif"; foreach my $old (@white_list) { my $new = $old; if ($new =~ s/white/main/i){ print "Renaming $old to $new\n"; rename($old, $new) or warn "$!"; } }
    poj

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1208352]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (2)
As of 2022-05-21 00:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (76 votes). Check out past polls.

    Notices?