Re^2: 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);
}
[download]

Comment on Re^2: rename files Download Code

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 "$!";
   }
}
[download]

[reply]
[d/l]


Think about Loose Coupling
	PerlMonks