Interesting script

[hyperphoenix]

Source of script:

http://wiki.preshweb.co.uk/doku.php?id=perl:scripts:auto-name-incoming

This script appears to have some usability for me but I am unsure where the watch & target folders should be placed in the script. Watch & Target are defined in the authors brief intro below. I am assuming the watch folder would be the folder that you want watched for new files and the target folder would be the destination of the files you copied ( wow deja vu ) Maybe I asked this question in a previous life. Anyway, If you know the answers can you please help me. How do you convert the windows style c:\ to a perl path so that this can read the directory. I did a quick lookup on google and found something related to #!c:/ but all my attempts of replacing the watch & folder failed with that method. If you can get it to work I'd like to know if it monitors and replaces every file or just specific files that are predefined. Also Does it work in a windows environment? Thanks for your help.


*********************************************************
#!/usr/bin/perl -w


# auto-name-incoming
#
# Quick dirty script to watch a directory for new files and automagically
# move them to another directory, automatically naming them,
#
# A useful trick for saving images from stock photo sites which are misconfigured
# so that the browser tries to save each image as download.php etc.
#
# A little rough, but not too bad for something knocked up in about 30 minutes
# at night. God bless Perl
#
# David Precious, October 2005

# $Id: auto-name-incoming 62 2006-11-15 23:46:41Z davidp $

$VERSION = '0.0.1';

use File::Copy;

my %parms = &get_cli_params;


if (!$parms{'watch'}) {
print "Must specify directory to watch for new files with --watch\n\n"
."Use --help for all options.\n";
exit 1;
}
if (!$parms{'target'}) {
print "Must specify target directory with --target\n\n"
."Use --help for all options.\n";
exit 2;
}

if ($params{'help'}) { &print_help; }

if ($parms{'version'}) { print "auto-name-incoming $VERSION\n"; exit; }

$parms{'watch'} .= '/' unless (substr($parms{'watch'}, -1, 1) eq '/');
$parms{'target'} .= '/' unless (substr($parms{'target'}, -1, 1) eq '/');


# right, get to it

#chdir($parms{'watch'});

while (1) {

opendir(DIR,$parms{'watch'}) || die("Cannot open directory !\n");
@files = readdir(DIR);
closedir(DIR);

foreach $file (@files) {
next if ($file eq "." || $file eq "..");

next if ($file =~ /\.part$/); # skip partial files...

$file = $parms{'watch'} . $file;

$ext = ($file =~ /\.(.+)$/)? $1 : '';
$ext = ($parms{'force-ext'})? $parms{'force-ext'} : $ext;
if ($ext && substr($ext, 0, 1) ne '.') { $ext = '.' . $ext; }

$prefix = ($parms{'prefix'})? $parms{'prefix'} : '';

$params{'start'} = 0 unless $params{'start'};

# TODO: make condition prevent x going over $digits
for (my $x = $params{'start'}; 1; $x++) {
$digits = &get_digits($x);
$targetfile = $parms{'target'} . $prefix . $digits . $ext;
last unless (-e $targetfile);
}

print "$file -> $targetfile\n";

copy($file, $targetfile) or die "File cannot be copied.";
unlink($file) || die "Failed to unlink $file ($!)!";

} # end of foreach loop through incoming files

sleep 1; # no need to continuously poll for files, so be nice


} # end of inifinite while() loop






sub get_digits {

my ($x, $d) = @_;

$d = ($d)? $d : 4;

return sprintf('%0'.$d.'d', $x);

}




sub print_help {

print qq[

auto-name-incoming takes the following parameters:

--watch=... specifies the directory to watch for incoming files

--target=... specifies the directory renamed files should go in

The following optional parameters customise its behaviour:

--digits= specifies the number of digits to use (default 4)

--prefix= specifies text to prefix the renamed file with

--force-ext= forces the file extension to this (default is to keep existing)

--start= forces digit numbering to start at given value

];
exit;

} # end of sub print_help



sub get_cli_params {
# returns a hash of all the parameters passed to us on the command
# line as --param[=value].

# let's get the params given to us on the command line:
my %myargs = ();
foreach $arg (@ARGV) {
if ($arg =~ /\-\-([a-z0-9_-]+)=?(.+)?$/ig) {
$myargs{$1} = $2;
if (!$myargs{$1}) { $myargs{$1} = ''; }
# make sure it that got set, since if the arg
# has no value, it won't get set otherwise.
}
}

return %myargs;

} # end of sub get_cli_params

 

[PinkeyNBrain]

If you're just wanting to hard code some directories, this will work

my %parms = &get_cli_params;
if (!$parms{'watch'}) {
   # This next command can be put on one line as a
   # continuous text string, but I've split it up for
   # readability (sometimes a browsers word wrap splits
   # things in odd places ...)
   $parms{'watch'} = 'C:/Documents and Settings/My Login' .
                     '/Local Settings' .
                     '/Temporary Internet Files' ;
}
if (!$parms{'target'}) {
   $parms{'target'} = 'C:/Documents and Settings/My Login' .
                      '/My Documents/My Pictures' ;
}

Note that the directory separators are / and not \.

I tried running the script using a couple of temp dirs (C:/temp and C:/temp2). Without any additional -- params, here was some of the output:

C:/temp/AP10207060615451 -> C:/temp2/0000
C:/temp/AP10207061115413 -> C:/temp2/0000

.... if you're wanting to keep any of these files you're copying, you may want to rethink how $targetfile is built. Otherwise you don't have much more than a committee style automatic file deleter.

 

[hyperphoenix]

*your wrote**
you may want to rethink how $targetfile is built
**end quote**


any suggestions?

 

[PinkeyNBrain]

This starts to get difficult in the fact that I can't be 100% sure of your final needs. The following is a bare bones version of the original script which is ignoring some of the params offered.

foreach $file (@files) {
    next if ($file eq "." || $file eq "..");
 
    next if ($file =~ /\.part$/); # skip partial files...
 
    $src_file = $parms{'watch'} . $file;
    $file_base = ($file =~ /^([^\.]+)/) ? $1 : "" ;
    $ext = ($file =~ /\.(.+)$/)? $1 : '';

    $digits = "00" ;

    $des_file = join("", $parms{'target'}, $file_base, "_", $digits, ".", $ext);

    while (-f $des_file) {
       $digits = substr("00" . ++$digits, -2);
       if ($digits >= 99) { $digits = -1 ; last ;}
       $des_file = join("", $parms{'target'}, $file_base, "_", $digits, ".", $ext);
    }
    if ($digits == -1) {
       # file naming wrap around
       $digits = 00 ;
       $des_file = join("", $parms{'target'}, $file_base, "_", $digits, ".", $ext);
    }
 
    print "$file -> $des_file\n";
 
    copy($src_file, $des_file) or die "File cannot be copied.";
    unlink($src_file) || die "Failed to unlink $file ($!)!";
 
} # end of foreach loop through incoming files

... I only ask that the local perl denizens don't scoff too loudly at the Conan style coding.

Possibly helpful option:
- instead of the 'or die <insert reason here>' logic, use 'warn' and keep a $failed_files{$file_name} = $fail_count hash/var. Try the file a couple more times and if you fail a couple of times, just stop trying that file.
- Keep another counter ($loop_count??) and do something like: if ((++$loop_count % 50) == 0) { <print something to provide a summary of what's in %failed_files.

 

[hyperphoenix]

thanks for your assistance. I don't actually have a goal with this other then to learn something new. It's nice to work on this without a deadline. I like working on these scripts just in case I might need to know this in the future. I am getting a few errors but I don't mind it'll give me something work on.

error around line 80. but not worries --

I'll try to use the $des_file instead of target --

 

[hyperphoenix]

solution -- the original file works

When you have the doc file open it can't save/delete because it's being used by another program in this case office 2007 which is sorta Temporamental to any type of sharing.

 

[PinkeyNBrain]

Kinda sounds like a job for %failed_files