Perl - Help Debug
Would anybody be able to look through my code real fast and try to figure out what I'm not seeing. I'm having troubles with my Perl debugger at this time, so that's not an option, until I fix it (in the process of investigating). Here's the code:
## Special Variables:
my @args = ();
my $spcl_dir = "$dir_root\\specialprocessing";
my $spcl_log = 'C:\Dad\Eclipse\Repositories\tiffinfo\!specialprocessing.log';
open(FILE, $spcl_log) || die "Couldn't open $spcl_log: $!\n";
for (my $i = 0 ; $i < 5 ; $i++) {
my $dummy = <FILE>;
}
print "\n$spcl_log\n"; # delete me
while (<FILE>) {
print "DEBUG START\n";
my (@fields) = split /;/;
my $filename = $fields[0];
print "Processing $filename";
print "DEBUG END\n";
}
## Copy process
print "\nStarting the copy process over to $spcl_dir:\n";
while (<FILE>) {
print "DEBUG START!\n";
my (@fields) = split /;/;
my $filename = $fields[0];
print "Copying $filename";
if (copy("$dir_root\\$filename", "$spcl_dir\\$filename")) {
print " - Success!\n";
}
else { print " - Failure!\n"; }
}
close(FILE);
## Confirmation of file copy
print "Everything look OK?: ";
chomp(my $confirmcopy = <STDIN>);
if ($confirmcopy =~ /^y|^yes/i ) {
print "\nAttempting to remove original files.\n";
## Original file deletion process
open(FILE, $spcl_log) || die "Couldn't open $spcl_log: $!\n";
for (my $i = 0 ; $i < 5 ; $i++) {
my $dummy = <FILE>;
}
while (<FILE>) {
my (@fields) = split /;/;
my $filename = $fields[0];
print "Attempting to remove: $filename";
if (unlink("$dir_root\\$filename")) {
print " - Success!\n";
}
else { print " - Failure!\n"; }
}
close(FILE);
}
else { print "Will do, exiting."; exit; }
## Conversion process
print "\nAttempting to convert the files.\n";
open(FILE, $spcl_log) || die "Couldn't open $spcl_log: $!\n";
for (my $i = 0 ; $i < 5 ; $i++) {
my $dummy = <FILE>;
}
while (<FILE>) {
my (@fields) = split /;/;
my $filename = $fields[0];
print "Starting conversion on $spcl_log\n";
@args = ("$tiffinfo_path", "$spcl_dir\\$filename", "/bpp=2", "/tifc=4", "/convert=$dir_root\\$filename", "/killmesoftly", "/silent");
system(@args);
unlink("$spcl_dir\\$filename");
}
close(FILE);
The desired output is the following:
Irfanview Found.
Directory exists. Continuing...
Starting the copy process over to c:\dad\tiffs\specialprocessing:
Copying filename2.tif - Failure!
Everything look OK?: n
Will do, exiting.
c:\Dad\Eclipse\Repositories\tiffinfo>perl c:\Users\Administrator\Desktop\exectif
finfo.pl
Irfanview Found.
Directory exists. Continuing...
Starting the copy process over to c:\dad\tiffs\specialprocessing:
Copying filename2.tif - Failure!
Everything look OK?: y
Attempting to remove original files.
Attempting to remove: filename2.tif - Failure!
Attempting to convert the files.
Starting conversion on filename2.tif
This is obviously going to be different, but you get the picture. Problem I am having is that everytime I seem to hit the while loop, nothing is processed, non of the code works. I've even tried simple debugging, such as print statements to see how far the code actually gets, and NOTHING in the while statements execute.
OUTPUT I RECEIVE (I have to CTRL-C out of the program as it doesn't quit on its own):
C:\Dad\Eclipse\Repositories\tiffinfo\!specialprocessing.log
Starting the copy process over to c:\dad\tiffs\specialprocessing:
Everything look OK?: y
Terminating on signal SIGINT(2)
The print statement before the while loop prints the "spcl_log" variable which is:
C:\Dad\Eclipse\Repositories\tiffinfo\!specialprocessing.log
CONTENTS OF LOG FILE (first five lines are always going to be skipped - this is what the dummy loop does):
IRFANVIEW BATCH ROUTINE
Work as: Batch Conversion
Output format: TIF
--OPTIONS: CCITT Fax 4 Save gryscl [default ON]
Adv Options: CHANGE COLOR DEPTH 2 colors (B/W) 1 BPP)
filename2.tif;Smpl/Pix & Bits/Smpl are missing.
CONTENTS OF THE WHOLE SCRIPT:
#!/usr/bin/perl -w
use 开发者_Go百科strict;
use warnings;
use File::Spec;
use Carp;
use File::Copy;
## Vars
my $dir_root;
my $state;
my $status;
my $batch;
my @files;
my $tifs;
my $executebat;
my $infile;
my $alphachnl;
my $errorlog;
my $corrupt;
my $specialLog;
#my $tiffinfo_path = "c:\\Program Files\\IrfanView\\i_view32.exe";
my $tiffinfo_path = "./converter.pl";
## Usage Vars
my $curVersion = "1.6";
my $options = $ARGV[0];
## Future Use Vars
my $totalErrors = 0;
my $fileCount = 0;
if ($#ARGV >= 0) {
usage() if $#ARGV > 0;
usage() if $options eq "-h";
version() if $options eq "-v";
}
sub version {
print "CompileTiffInfo.exe\n";
print "Version: $curVersion\n";
exit( 0 );
}
sub usage {
print "\nUsage: compileTiffInfo.exe [OPTIONS]\n";
print "Processes a directory of TIF images, and outputs the data to 3 different text files.\n\n";
print "compileTiffInfo.exe (default)\n\tRuns the program through an interactive menu.\n\n";
print "compileTiffInfo.exe -v\n\tShows version information for this program\n\n";
print "compileTiffInfo.exe -h\n\tShows this help menu\n";
exit( 0 );
}
system 'cls';
## Check if tiffinfo is installed.
if (-e $tiffinfo_path) {
print "Irfanview Found." . "\n";
}
else {
print "Irfanview was not found." . "\n";
exit ( 0 );
}
## Check passcode
if (defined($ARGV[0])) {
if ($ARGV[0] ne $curVersion ) {
print "Passcode not recognized.";
exit ( 0 );
}
}
else {
print "Passcode not recognized.";
exit ( 0 );
}
## Start of actual program; asks user where the TIF images are located.
print "Where are your TIF file(s) located? (C:\\directory\\of\\your\\tiff\\files): ";
chomp($dir_root = <STDIN>);
if (! -d $dir_root) {
print "Directory doesn't exist!\n";
exit;
}
if ($dir_root =~ tr/ / /) {
print "There's spaces in your path. Try again.\n";
exit;
}
if ($dir_root =~ /\\$/) {
print "You ended with a slash. This is not allowed; try again.";
exit;
}
print "State: [LA,NM,OK,UT,TX,WY] - [--,none,other]: ";
chomp($state = uc(<STDIN>));
if ($state eq "") {
print "Whoa! No data was entered. Exiting.";
exit;
}
if ($state eq "OTHER" || $state eq "NONE" || $state eq "--") {
print "\n ** NOTE: Entering into STANDARD SPREADSHEET OUTPUT MODE **\n\n"
}
print "Status [nr][hs][tye] or Anything Descriptive: ";
chomp($status = lc(<STDIN>));
print "Batch #? ";
chomp($batch = uc(<STDIN>));
## Define the output file, based on user input
my $batOutput = "\!".$state.$status."INFOraw.txt";
open (BATFILE, "> \!".$state.$status."INFOraw.bat");
print BATFILE "\@echo off\n";
close (BATFILE);
open (BATFILE, ">> \!".$state.$status."INFOraw.bat");
print BATFILE "type nul > $batOutput\n";
close (BATFILE);
## Get a list of tif files from dir_root
## No trailing slash is allowed
opendir(DIR, $dir_root);
@files = grep(/\.ti[f]{1,2}$/i,readdir(DIR));
closedir(DIR);
## Check to see if array has data
if (@files) {
foreach $tifs (@files) {
open (BATFILE, ">> \!".$state.$status."INFOraw.bat");
print BATFILE "tiffinfo TYPE $dir_root"."\\".$tifs." \>> ".$batOutput."\n";
## Need to write to INFO file, for each file, eliminating the .bat file.
close (BATFILE);
}
}
## if array is null (no data), then no tif files were found
else {
print "No Tiff files were found.";
exit;
}
## Run bat script
print "Attempting to execute .bat script now...\n";
$executebat = system 'call !'.$state.$status.'INFOraw.bat > NUL 2>&1';
if ( $executebat != 0 ) {
die "Failed executing .bat script. \n";
}
else { print "Ran .bat script successfully.\n\n"; }
## Debugging Only
#$infile = 'data.txt';
$infile = $batOutput;
## Output File Handles (open)
open(OUT1,"> \!".$state.$status."INFO.txt") or die "Can't open \!".$state.$status."INFO.txt: $!";
open(OUT2,"> \!".$state.$status."INFOspdsht.txt") or die "Can't open \!".$state.$status."INFO.txt $!";
open(ERRLOG,"> \!errors.log") or die "Can't open !errors.log $!";
open(CORRUPT,"> \!corrupt.log") or die "Can't open !corrupt.log $!";
open(SPECIAL,"> \!specialprocessing.log") or die "Can't open !specialprocessing.log $!";
## Print Headers To spdsht file
print OUT2 ";;;;Whitespace;;DPI ReSize;;;\n";
print OUT2 "Filename;Comp;AlphCnl;Foto;Wid;Len;Res 0;x0;;;MB\n";
print CORRUPT "Filename;Reason For Failure\n";
print SPECIAL "IRFANVIEW BATCH ROUTINE\nWork as: Batch Conversion\nOutput format: TIF\n--OPTIONS: CCITT Fax 4 Save gryscl [default ON]\nAdv Options: CHANGE COLOR DEPTH 2 colors (B/W) 1 BPP)\n";
## Configuration Data for masking data output
my %config = (
'LZW' => 'colors',
'Lempel-Ziv & Welch encoding' => 'colors',
'CCITT Group 4' => 'bkwhts',
'CCITT Group 4 facsimile encoding' => 'bkwhts',
'None' => 'none',
'none' => 'none',
'RGB color' => 'colors',
'min-is-white' => 'bkwhts',
'min-is-black' => 'bkwhts',
'palette color (RGB from colormap)' => 'colors',
'Resolution' => sub {
my @r = split(/, /, shift);
$r[0] =~ s/\D//g;
$r[1] =~ s/\D//g;
return @r[0,1];
},
);
my @config = keys %config;
#my $file = $infile; # set this as needed.
my $file = "data.txt";
open my $fh, '<', $file or die "can't open <$file> for reading $!";
$/ = "TYPE:\n";
while ( my $record = <$fh> ) {
chomp $record;
next if $record eq '';
$record =~ s/(TIFF Directory at offset .+)\n//;
## Future use, for incrementing errors
my $errorCount = 0;
my ($fullpath, $data) = split(/\n/, $record, 2);
$fullpath =~ s/:$//;
my ($drv, $path, $file) = File::Spec->splitpath($fullpath);
## Start processing the file
print "Processing $file\n";
$fileCount++;
## Get Compression Scheme data
my $cs = $config{$1} if ($data =~ s/\s{2}Compression Scheme:\s+(.*?)\n//);
if (!defined $cs) {
print "[ERROR]: Compression Scheme for $file not found.\n";
#print ERRLOG "[ERROR]: Compression Scheme for $file not found.\n";
$cs = "unknwn";
$errorCount++;
}
## Get Photometric Interpretation data
my $pi = $config{$1} if ($data =~ s/\s{2}Photometric Interpretation:\s+(.*?)\n//);
if (!defined $pi) {
print "[ERROR]: Photometric Interpretation for $file not found.\n";
print ERRLOG "[ERROR]: Photometric Interpretation for $file not found.\n";
$pi = "unknwn";
$errorCount++;
}
## Get Bits/Sample data
my $bits = $1 if ($data =~ s/\s{2}Bits\/Sample:\s+(.*?)\n//);
if (!defined $bits) {
print "[ERROR]: Bits/Sample data for $file not found.\n";
print ERRLOG "[ERROR]: Bits/Sample data for $file not found.\n";
$bits = "unknwn";
$errorCount++;
}
## Get Samples/Pixel data
my $pixels = $1 if ($data =~ s/\s{2}Samples\/Pixel:\s+(.*?)\n//);
if (!defined $pixels) {
print "[ERROR]: Samples/Pixel data for $file not found.\n";
print ERRLOG "[ERROR]: Samples/Pixel data for $file not found.\n";
$pixels = "unknwn";
$errorCount++;
}
## Get AlphaChnl Value (bits * pixels)
if (!($pixels eq '') && !($bits eq '')) {
if (!($pixels eq "unknwn") && !($bits eq "unknwn")) {
$alphachnl = $bits * $pixels;
if ($alphachnl == 1) {
$alphachnl = "bkwhts";
}
elsif ($alphachnl == 8) {
$alphachnl = "colors";
}
elsif ($alphachnl == 24) {
$alphachnl = "doLOGO";
}
}
}
else {
$alphachnl = "unknwn";
print "[ERROR]: Alpha Channel for $file had issues (probably due to Bits/Sample or Sample/Pixel issue.)\n";
$errorCount++;
print "[ERROR]: Alpha Channel for $file had issues (probably due to Bits/Sample or Sample/Pixel issue.)\n";
}
## Get Resolution data
my @r = $config{'Resolution'}->($1) if ($data =~ s/\s{2}Resolution:\s+(.*?)\n//);
## Get Width/Length data
my ($w, $l) = ($1, $2) if ($data =~ s/\s{2}Image Width: (\d+) Image Length: (\d+)\n//);
## Width
if (!defined $w) {
print "[ERROR]: Width for $file not found.\n";
print ERRLOG "[ERROR]: Width for $file not found.\n";
$errorCount++;
#next;
}
## Length
if (!defined $l) {
print "[ERROR]: Length for $file not found.\n";
print ERRLOG "[ERROR]: Length for $file not found.\n";
$errorCount++;
#next;
}
## Width
if (!defined $w) {
print "[ERROR]: Width for $file not found.\n";
print ERRLOG "[ERROR]: Width for $file not found.\n";
$errorCount++;
}
## Length
if (!defined $l) {
print "[ERROR]: Length for $file not found.\n";
print ERRLOG "[ERROR]: Length for $file not found.\n";
$errorCount++;
$l = "unknwn";
}
## Resolution
if (!defined $r[0] || !defined $r[1]) {
print "[ERROR]: Resolution for $file not found.\n";
print ERRLOG "[ERROR]: Resolution for $file not found.\n";
$errorCount++;
#next;
}
## Resolution
if (!defined $r[0] || !defined $r[1]) {
print "[ERROR]: Resolution for $file not found.\n";
print ERRLOG "[ERROR]: Resolution for $file not found.\n";
$errorCount++;
$r[0] = "unknwn";
$r[1] = "unknwn";
}
## Get Rows/Strip data
my $strip = $1 if ($data =~ s/\s{2}Rows\/Strip:\s+(.*?)\n//);
if (!defined $strip) {
print "[ERROR]: Rows/Strip data for $file not found.\n";
print ERRLOG "[ERROR]: Rows/Strip data for $file not found.\n";
$errorCount++;
}
## Get Size of TIF(F) file(s)
#my $filesize = (-s $fullpath) / (1024 * 1024); ## Uncomment when in production
my $filesize = "2"; ## REMOVE - Testing Purposes only to "fake" an image size.
my $size_in_mb = sprintf "%.2f", $filesize;
## Error Check
if ($errorCount == 8) {
print "[FAILURE]: Not processed, image may be CORRUPT.\n";
print CORRUPT "$file;High Probability - IMAGE CORRUPT.";
$totalErrors++;
next;
}
if ($pixels eq "unknwn" && $bits eq "unknwn") {
print "[INFO]: Specially processed image.\n";
print SPECIAL "$file;Smpl/Pix & Bits/Smpl are missing.\n";
$totalErrors++;
next;
}
if ($errorCount > 0) {
print "[ERROR]: $file was not processed, too many errors.\n";
$totalErrors++;
next;
}
$data =~ s/\n$//;
## ** For Debugging - Prints To Screen **
## print $/, join(':', $file, $cs, $bits, $pi, $w, $l, @r, $size_in_mb, "\n"), $data, "\n";
print OUT1 $/, join(';', $file, $cs, $bits, $pixels, $pi, $w, $l, @r, $size_in_mb, "\n"), $data, "\n";
## LA Output
if ($state eq "LA") {
print OUT2 "$file;", "$cs;", "$alphachnl;", "$pi;", "$w;", "$l;", "$r[0];$r[1];;;", "$size_in_mb;;","\'$batch;;;;","start;","$file;;;;;;;;;;","$size_in_mb;","move;","$file;","$dir_root\\done;", "\n";
}
## NM Output
elsif ($state eq "NM") {
print OUT2 "$file;", "$cs;", "$alphachnl;", "$pi;", "$w;", "$l;", "$r[0];$r[1];;;", "$size_in_mb;;","\'$batch;;;;","start;","$file;","$size_in_mb;","move;","$file;","$dir_root\\done;", "\n";
next;
next;
}
## OK/UT Output
elsif ($state eq "OK" || $state eq "UT") {
print OUT2 "$file;", "$cs;", "$alphachnl;", "$pi;", "$w;", "$l;", "$r[0];$r[1];;;", "$size_in_mb;;","\'$batch;;;;","start;","$file;","$size_in_mb;","move;","$file;","$dir_root\\done;","start;",$file."f;","move;",$file."f;","$dir_root\\done\\TEMPdone;", "\n";
next;
next;
}
## TX/WY Output
elsif ($state eq "TX" || $state eq "WY") {
print OUT2 "$file;", "$cs;", "$alphachnl;", "$pi;", "$w;", "$l;", "$r[0];$r[1];", "move $dir_root\\$file $dir_root\\$cs\\$file;;", "$size_in_mb;;", "\'$batch;;;","start;", "$dir_root\\$cs\\$file;", "$file;","$size_in_mb;","move;", "$dir_root\\$cs\\$file;", "$dir_root\\done;","start;", $file."f;", "move;", $file."f;", "$dir_root\\done\\TEMPdone;", "\n";
next;
next;
}
elsif ($state eq "NONE" || $state eq "--" || $state eq "OTHER") {
print OUT2 "$file;", "$cs;", "$alphachnl;", "$pi;", "$w;", "$l;", "$r[0];$r[1];", "$size_in_mb\n";
next;
next;
}
}
print "\nTotal Files Processed: $fileCount\n";
print "High Probability Failures: $totalErrors / Failure Rate: ".$totalErrors * 100 / $fileCount."%\n";
close (OUT1) or die "Can't close out1: $!";
close (OUT2) or die "Can't close out2: $!";
close (ERRLOG) or die "Can't close error log: $!";
close (CORRUPT) or die "Can't close corrupt log: $!";
close (SPECIAL) or die "Can't close corrupt log: $!";
close ($fh) or die "Can't close $fh: $!";
$errorlog = "\!errors.log";
if (-s $errorlog == 0) {
unlink($errorlog) or die "Can't delete $errorlog : $!";
}
else { print "Error log saved.\n\n"; }
#$corrupt = "\!corrupt.log";
#if (-s $corrupt == 0) {
# unlink($corrupt) or die "Can't delete $corrupt : $!";
#}
#else { print "Corrupt log saved."; }
#$specialLog = "\!specialprocessing.log";
#if (-s $specialLog == 0) {
# unlink($specialLog) or die "Can't delete $specialLog : $!";
#}
#else { print "Special Processing log saved."; }
## Starting Tiffinfo Processing:
my $spcl_dir = "dst";
my $spcl_log = "!specialprocessing.log";
print "DIR_ROOT: $dir_root\n";
print "SPCL_LOG: $spcl_log\n";
print "TIFFINFO_PATH: $tiffinfo_path\n";
sub get_files_list
{
my($log) = @_;
open my $file, '<', $log or croak "Couldn't open $log: $!\n";
# Skip heading lines
for (my $i = 0 ; $i < 5 ; $i++)
{
my $dummy = <$file>;
}
my @files;
while (<$file>)
{
my (@fields) = split /;/;
my $filename = $fields[0];
push @files, $filename;
}
close $file or croak "Couldn't close $log: $!\n";
return @files;
}
my @spcl_files = get_files_list($spcl_log);
print "\n$spcl_log\n"; # delete me
## Copy original files
print "\nStarting the copy process over to $spcl_dir:\n";
foreach my $filename (@spcl_files)
{
print "Copying $filename";
if (copy("$dir_root/$filename", "$spcl_dir/$filename"))
{
print " - Success!\n";
}
else
{
print " - Failure! ($!)\n";
}
}
## Confirmation of file copy
print "Everything look OK?: ";
chomp(my $confirmcopy = <STDIN>);
if ($confirmcopy !~ /^y|^yes/i )
{
print "Will do, exiting.\n";
exit 0;
}
## Delete original files
print "\nAttempting to remove original files.\n";
foreach my $filename (@spcl_files)
{
print "Attempting to remove: $filename";
if (unlink("$dir_root/$filename"))
{
print " - Success!\n";
}
else
{
print " - Failure! ($!)\n";
}
}
## Conversion process
print "\nAttempting to convert the files.\n";
foreach my $filename (@spcl_files)
{
print "Starting conversion on $filename\n";
my @args = ("$tiffinfo_path", "$spcl_dir/$filename", "/bpp=2",
"/tifc=4", "/convert=$dir_root/$filename",
"/killmesoftly", "/silent");
if (system(@args) != 0)
{
carp "Failed to convert $filename ($!)";
}
else
{
unlink("$spcl_dir/$filename") or carp "Failed to unlink $spcl_dir/$filename ($!)";
}
}
NOTES: Only thing I changed was I added:
print "DIR_ROOT: $dir_root\n";
print "SPCL_LOG: $spcl_log\n";
print "TIFFINFO_PATH: $tiffinfo_path\n";
...for debugging purposes. And the other other thing is that I renamed the array @files
to @spcl_files
since @files
was already defined in my main script.
STILL THE PROBLEM: Here's my current output:
Irfanview Found.
Where are your TIF file(s) located? (C:\directory\of\your\tiff\files): c:\dad\ti
ffs
State: [LA,NM,OK,UT,TX,WY] - [--,none,other]: tx
Status [nr][hs][tye] or Anything Descriptive: nr
Batch #? 1
Attempting to execute .bat script now...
Ran .bat script successfully.
Processing filename.tif
Processing filename2.tif
[ERROR]: Bits/Sample data for filename2.tif not found.
[ERROR]: Samples/Pixel data for filename2.tif not found.
[INFO]: Specially processed image.
Total Files Processed: 2
High Probability Failures: 1 / Failure Rate: 50%
Error log saved.
DIR_ROOT: c:\dad\tiffs
SPCL_LOG: !specialprocessing.log
TIFFINFO_PATH: ./converter.pl
!specialprocessing.log
Starting the copy process over to dst:
Everything look OK?: n
For staters, it still doesn't show the filename after the "Starting the copy process over to dst" and whether I hit Y or N for the "Everything look OK?" part, it just hangs there and does nothing.
NEW CODE/OUTPUT 11/26 @ 3PM CST:
my @spcl_files = get_files_list($spcl_log);
print $spcl_files[0];
print "YO";
Output:
Use of uninitialized value in print at compileTiffInfo.pl line 445.
YO
Starting the copy process over to dst:
Everything look OK?: Terminating on signal SIGINT(2)
Thanks in advanced! :)
You set up input separator (on line 190):
$/ = "TYPE:\n";
Your DEBUG START, DEBUG END while
loop is eating all the data in the file - and then you expect the main loop to read new data from the same file.
Either:
- Lose the debug loop.
Or:
- Revise the debug loop to generate the list of files in an array, and then have the main loop read the file names from the array instead of the input file.
Your desired output isn't all available from the code shown, either - the first line, in particular, does not seem to have any code to print it.
Deconstruction of code
You code has the same bit of code written out 3 times - the stuff that skips 5 lines and splits out the file name. In the answer to SO 4272615, you were given a set functions that would give you an array with the list of file names to process. Use functions - they make code easier to manage!
I observe that your code does not include 'use strict;
' or 'use warnings
'; experts use them all the time to make sure they don't make mistakes, and beginners need to use them all the time to make sure they don't make mistakes. As it happens, the only issues it throws up are 'undeclared variables', so your code is not bad.
When I run the code (hacked so the directories are appropriate for my machine), the first DEBUG loop runs and eats up the data; the second loop therefore reports nothing. If I try to let it run, it then complains that the function main::copy
is not found. Presumably, that is fixed by adding 'use File::Copy;
', but it helps if you post the actual code you are using, not a butchered semblance to it.
Even on Windows, you are better off not using '\\
' in the pathnames; you can use '/
' in them and the o/s is quite happy; it is cmd.exe
that is not keen on slashes instead of backslashes.
Simulation environment
The code below WFM - works for me (test environment: MacOS X 10.6.5, Perl 5.13.4). I created a file 'data.file' from the previous question. I created sub-directories 'safe', 'src' and 'dst', and created empty files 'filename2.tif', 'filename4.tif', 'filename6.tif', 'filename8.tif' in 'safe'. I then linked the files from 'safe' to 'src' so I could rerun the script easily, despite it unlinking the input files.
ln safe/* src
I also created a script 'converter':
echo "$0 $@"
Example Output
The output from the program was then:
data.file
Starting the copy process over to dst:
Copying filename2.tif - Success!
Copying filename4.tif - Success!
Copying filename6.tif - Success!
Copying filename8.tif - Success!
Everything look OK?: y
Attempting to remove original files.
Attempting to remove: filename2.tif - Success!
Attempting to remove: filename4.tif - Success!
Attempting to remove: filename6.tif - Success!
Attempting to remove: filename8.tif - Success!
Attempting to convert the files.
Starting conversion on filename2.tif
./converter dst/filename2.tif /bpp=2 /tifc=4 /convert=src/filename2.tif /killmesoftly /silent
Starting conversion on filename4.tif
./converter dst/filename4.tif /bpp=2 /tifc=4 /convert=src/filename4.tif /killmesoftly /silent
Starting conversion on filename6.tif
./converter dst/filename6.tif /bpp=2 /tifc=4 /convert=src/filename6.tif /killmesoftly /silent
Starting conversion on filename8.tif
./converter dst/filename8.tif /bpp=2 /tifc=4 /convert=src/filename8.tif /killmesoftly /silent
Reconstruction of code
#!/usr/bin/env perl
use strict;
use warnings;
use Carp;
use File::Copy;
my $spcl_dir = "dst";
my $spcl_log = "data.file";
my $dir_root = "src";
my $tiffinfo_path = "./converter";
sub get_files_list
{
my($log) = @_;
open my $file, '<', $log or croak "Couldn't open $log: $!\n";
# Skip heading lines
for (my $i = 0 ; $i < 5 ; $i++)
{
my $dummy = <$file>;
}
my @files;
while (<$file>)
{
my (@fields) = split /;/;
my $filename = $fields[0];
push @files, $filename;
}
close $file or croak "Couldn't close $log: $!\n";
return @files;
}
my @files = get_files_list($spcl_log);
print "\n$spcl_log\n"; # delete me
## Copy original files
print "\nStarting the copy process over to $spcl_dir:\n";
foreach my $filename (@files)
{
print "Copying $filename";
if (copy("$dir_root/$filename", "$spcl_dir/$filename"))
{
print " - Success!\n";
}
else
{
print " - Failure! ($!)\n";
}
}
## Confirmation of file copy
print "Everything look OK?: ";
chomp(my $confirmcopy = <STDIN>);
if ($confirmcopy !~ /^y|^yes/i )
{
print "Will do, exiting.\n";
exit 0;
}
## Delete original files
print "\nAttempting to remove original files.\n";
foreach my $filename (@files)
{
print "Attempting to remove: $filename";
if (unlink("$dir_root/$filename"))
{
print " - Success!\n";
}
else
{
print " - Failure! ($!)\n";
}
}
## Conversion process
print "\nAttempting to convert the files.\n";
foreach my $filename (@files)
{
print "Starting conversion on $filename\n";
my @args = ("$tiffinfo_path", "$spcl_dir/$filename", "/bpp=2",
"/tifc=4", "/convert=$dir_root/$filename",
"/killmesoftly", "/silent");
if (system(@args) != 0)
{
carp "Failed to convert $filename ($!)";
}
else
{
unlink("$spcl_dir/$filename") or carp "Failed to unlink $spcl_dir/$filename ($!)";
}
}
Notes
- Check that the conversion succeeds (
system
) before removing the file. - Check that the
unlink
succeeds. - Include the Perl error information '
$!
' in the error messages. - Use '
use Carp;
' andcarp
andcroak
instead ofwarn
anddie
. - Function
get_file_list()
used to get the list of files - just once. - The function uses a lexical file handle
$file
instead ofFILE
. - It also uses the three argument form of
open
, which is the most reliable form. - It also uses the low priority 'or' connective instead of '||'. (In context, with the parentheses around the
open
, the '||' is correct; if you omit the parentheses as in the rewrite, then 'or' is necessary.) - The code does an early exit when the response is 'do not continue'.
- The
foreach
loops iterate of the list of files. - The
exit
has an explicit status of 0 (success).
Well, you are obviously not getting anything back from <FILE>
.
Maybe you changed the input record seperator ($/
) somewhere?
To investigate, extend the for loop to:
for (my $i = 0 ; $i < 5 ; $i++) {
my $dummy = <FILE>;
print $dummy;
}
That should give you a pretty good idea what is going on here.
Also, consider reading the file in an array (my @lines = <FILE>;
), since you use the information more than once.
精彩评论