Can't get my filename pattern matching working....can anyone help?!

[Cara83]

Hi everyone,

I am only new to this Perl programming world and I am having problems with the script I am writing.

The program is supposed to search a number of specified directories for files with certain names or file type and that are older than 30 days and then move them to an archive folder. Once inside the archive folder, any files greater than 60 days are permanently deleted from the directory.

The problem is I only want to process files with particular filenames and not others. No matter what way i write my code, it either sees every file and processes all files, even the ones I want to exclude, or it doesnt process any files.

Can anyone help me on this???
I can post up my code if needed....

Any help is much appreciated guys!!

Cheers
Cara

 

[prex1]

Post your code

prex1

http://www.xcalcs.com

: Online tools for structural design

http://www.megamag.it

: Magnetic brakes for fun rides

http://www.levitans.com

: Air bearing pads

 

[Cara83]

Hi Prex1,

here is my code, it has been wrecking my head all day, i have several of the perl books, but they just dont help.
No-one else in my job knows perl. i want to only process the files that have the letters in $name at the start of the file name only, and no other files.
Any ideas??
Thanks again,
Cheers
Cara



#!C:/Perl/bin/perl.exe

use strict;
use File::Copy;
use Net::FTP;
my $TODAY = time;

my @dirArray = ('C:/AIS/oam/Tgt',
'C:/AIS/oam/Tgt/PLACE/Log/AltInspData/old',
'C:/AIS/oam/Tgt/PLACE/Log/FailsAlternate',
'C:/AIS/oam/Tgt/PLACE/Log/FailsAlternate/OLD',
'C:/AIS/oam/Tgt/PLACE/Log/gluedata',
'C:/AIS/oam/Tgt/PLACE/Log/Old',
'C:/AIS/oam/Tgt/PLACE/Log/stats');

my @archDirArray = ('C:/AIS/oam/Tgt/archive',
'C:/AIS/oam/Tgt/PLACE/Log/AltInspData/old/archive',
'C:/AIS/oam/Tgt/PLACE/Log/FailsAlternate/archive',
'C:/AIS/oam/Tgt/PLACE/Log/FailsAlternate/OLD/archive',
'C:/AIS/oam/Tgt/PLACE/Log/gluedata/archive',
'C:/AIS/oam/Tgt/PLACE/Log/Old/archive',
'C:/AIS/oam/Tgt/PLACE/Log/stats/archive');

#my $name = /^BAK|^KRK|^KRX|^KMK|^GRK|^KFX|^GRE|^GRX|^TNK|^PNE|^PTK|^PTX|^PQK|^TNK|^FAKEID|^Place|^tbak|^tgre|^tgrk|^tkfk|^tkfx|^tkrk|^tkrx|^ttnk|^Tgre|^day_|^ctrl|^running_|^lifetime_/;

my $name = /^BAK+|^KRK+|^KRX+|^KMK+|^GRK+|^KFX+|^GRE+|^GRX+|^TNK+|^PNE+|^PTK+|^PTX+|^PQK+|^TNK+|^FAKEID+|^Place+|^tbak+|^tgre+|^tgrk+|^tkfk+|^tkfx+|^tkrk+|^tkrx+|^ttnk+|^Tgre+|^day_+|^ctrl+|^running_+|^lifetime_+/;

my @fileModeArray = ('log', 'sht', 'err', 'gui', 'col', 'vis');

my $TwoMonthsTime = 5184000; # (ie 60secs X 60mins X 24hours X 60days)
my $monthTime = 2592000; # (ie 60secs X 60mins X 24hours X 30days)

#########################################################################

sub delete_old_files
{
open (DLOGFILE, ">C:/OAM/FilesToBeDeleted.txt");
my $numDel= 0;
my $numArchDir=0;
while ($numArchDir < 7)
{
my $archDIR = $archDirArray[$numArchDir];
opendir archDIR, $archDIR or die "could not open directory: $!";
while (my $file = readdir archDIR)
{
next if -d "$archDIR/$file";
my $mtime = (stat "$archDIR/$file")[9];
my $mode = (stat "$archDIR/$file")[2];
if($file =~ $name)
{
if($TODAY - $TwoMonthsTime > $mtime)
{
print DLOGFILE "$archDIR/$file is older than 60 days...removing\n";
unlink "$archDIR/$file";
$numDel++;
}
}
}
$numArchDir++;
close archDIR;
}
if ($numDel > 0)
{
print "\n\n$numDel file(s) deleted.\n\n\n";
}
else
{
print "\n\nThere were no files deleted\n\n\n";
}
}
close DLOGFILE;

#####################################################################

sub archive_files
{
open (ALOGFILE, ">C:/OAM/FilesToBeArchived.txt");
my $numArch= 0;
my $numDir=0;
print "\n";
print 'Archiving........';
print "\n\n";
while ($numDir < 7)
{
my $DIR = $dirArray[$numDir];
opendir DIR, $DIR or die "could not open directory: $!";
while (my $file = readdir DIR)
{
next if -d "$DIR/$file";
my $mtime = (stat "$DIR/$file")[9];
my $mode = (stat "$DIR/$file")[2];
if($file =~ $name)
{
if($TODAY - $monthTime > $mtime)
{
print ALOGFILE "$DIR/$file is older than 30 days...archiving\n";
my $oldlocation = "$DIR/$file";
my $newlocation = "$DIR//archive//$file";
move($oldlocation, $newlocation) or die "move failed: $!";
$numArch++;
}
}
}
$numDir++;
close DIR;
}
if ($numArch> 0)
{
print "\n\n$numArch file(s) archived.\n\n\n";
}
else
{
print "\n\nThere were no files archived\n\n\n";
}
}
close ALOGFILE;

#################################################################

Main:
{
my $value=0;
print "\n";
print 'File Cleanup';
print "\n\n";
print 'Directories to be cleaned up are: ';
while ($value < 7)
{
print "\n";
print $dirArray[$value];
$value++;
}
print "\n\n";
print 'Files to be archived saved in C:/OAM/FilesToBeArchived.txt';
archive_files();
print 'Files to be deleted saved in C:/OAM/FilesToBeDeleted.txt';
print "\nSearching for files over 60 days..........";
delete_old_files();
}

 

[travs69]

You can do
$test = '^aaa||^bbb||^ccc';

if ($name =~ /$test/) {
blah blah
}


~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Travis - Those Who Say It Cannot Be Done Are Usually Interrupted by Someone Else Doing It; Give the wrong symptoms, get the wrong solutions;

 

[KevinADC]

or maybe:

my $name = qr/^BAK+|^KRK+|^KRX+|^KMK+|^GRK+|^KFX+|^GRE+|^GRX+|^TNK+|^PNE+|^PTK+|^PTX+|^PQK+|^TNK+|^FAKEID+|^Place+|^tbak+|^tgre+|^tgrk+|^tkfk+|^tkfx+|^tkrk+|^tkrx+|^ttnk+|^Tgre+|^day_+|^ctrl+|^running_+|^lifetime_+/;


what are the + symbols for in the above?

------------------------------------------
- Kevin, perl coder unexceptional!

 

[ishnid]

The '+' symbols are redundant. Anything that starts with (for example) BAKKKKK...K also starts with BAK, so matching the extra 'K' characters doesn't help any. You could also shorten that by removing the repeated '^' anchors, like so:

my $name = qr/^(?:BAK|KRK|KMK|GRK|KFX|GRE)/;

I've only typed out a few, but you get the picture.

 

[Cara83]

Hi guys,

I tried all your solutions thanks for the quick replies.
I have the + in because I read in one of the perl books that leaving out the plus will result in the null character being matched every time before even matching one of the letters in the string.
What does the 'qr' do?? because it seems to be working and running on my laptop!!
But tommorrow i will try running it on the machine it is written for, so fingers crossed. I'll write up another update tommorrow on the outcome.
Thanks again!!!

Cheers
Cara