【问题标题】:Perl - Help DebugPerl - 帮助调试
【发布时间】:2010-11-25 21:39:27
【问题描述】:

是否有人能够真正快速地查看我的代码并尝试找出我没有看到的内容。目前我的 Perl 调试器有问题,所以这不是一个选择,直到我修复它(在调查过程中)。代码如下:

## 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);

所需的输出如下:

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

这显然会有所不同,但你明白了。我遇到的问题是,每次我似乎点击 while 循环时,什么都没有处理,代码也不起作用。我什至尝试过简单的调试,例如打印语句以查看代码实际执行的程度,以及在 while 语句中执行 NOTHING。

我收到的输出(我必须按 CTRL-C 退出程序,因为它不会自行退出):

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)

while循环之前的打印语句打印“spcl_log”变量,即:

C:\Dad\Eclipse\Repositories\tiffinfo\!specialprocessing.log

日志文件的内容(前五行总是会被跳过 - 这是虚拟循环所做的):

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.

整个脚本的内容:

#!/usr/bin/perl -w

use 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 ($!)";
    }
}

注意事项: 我唯一改变的是我添加了:

print "DIR_ROOT: $dir_root\n";
print "SPCL_LOG: $spcl_log\n";
print "TIFFINFO_PATH: $tiffinfo_path\n";

...用于调试目的。另一件事是我将数组@files 重命名为@spcl_files,因为@files 已经在我的主脚本中定义了。

问题依旧: 这是我当前的输出:

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

对于声明者,在“开始复制过程到 dst”之后,它仍然不显示文件名,以及“一切看起来都好吗?”是按 Y 还是 N。部分,它只是挂在那里,什么也不做。

新代码/输出 11/26 @ 3PM CST:

my @spcl_files = get_files_list($spcl_log);
print $spcl_files[0];
print "YO";

输出:

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)

提前致谢! :)

【问题讨论】:

  • 分享你实际看到的输出。在第一个 while 循环之前有一个 print 语句。它打印什么?
  • 日志文件的内容是什么?你可以发布一个例子吗?您从日志文件中读取 5 行的顶部的虚拟循环是什么?另外你没有发布整个代码。
  • 你打开的文件是不是真的超过了5行?
  • 你能把你现在得到的输出作为输出发布吗?
  • 刚刚更新了我的主要问题 - 已请求所有更新信息。

标签: perl debugging while-loop


【解决方案1】:

您设置了输入分隔符(在第 190 行):

$/ = "TYPE:\n";

【讨论】:

  • 是的...?请解释一下。
  • 搜索“输入记录分隔符”或在 perlvar 手册页 perldoc.perl.org/perlvar.html 上搜索 $/
  • 哇!这实际上修复了它! :D。将原始文件句柄(第 185 行)放入花括号中,并将输入记录分隔符更改为 local $/ = "TYPE:\n";,所有代码都神奇地开始按预期工作。 jira,好眼力!
  • @drewrockshard:我写了“也许您在某处更改了输入记录分隔符 ($/)?”两天前。正是我所怀疑的......
【解决方案2】:

您的 DEBUG START、DEBUG END while 循环正在吃掉文件中的所有数据 - 然后您希望主循环从同一个文件中读取新数据。

要么:

  • 失去调试循环。

或者:

  • 修改调试循环以生成数组中的文件列表,然后让主循环从数组而不是输入文件中读取文件名。

您想要的输出也不能从显示的代码中获得 - 特别是第一行,似乎没有任何代码可以打印它。


代码解构

您的代码将相同的代码写出 3 次 - 跳过 5 行并拆分文件名的内容。在SO 4272615 的答案中,您获得了一组函数,该函数将为您提供一个包含要处理的文件名列表的数组。使用函数 - 它们使代码更易于管理!

我观察到您的代码不包含“use strict;”或“use warnings”;专家一直在使用它们以确保它们不会出错,而初学者则需要一直使用它们以确保它们不会出错。碰巧的是,它引发的唯一问题是“未声明的变量”,因此您的代码还不错。

当我运行代码时(修改后的目录适合我的机器),第一个 DEBUG 循环运行并吃掉数据;因此,第二个循环不报告任何内容。如果我尝试让它运行,它会抱怨找不到函数main::copy。据推测,这可以通过添加“use File::Copy;”来解决,但如果您发布您正在使用的实际代码,而不是与它的相似之处,它会有所帮助。

即使在 Windows 上,最好不要在路径名中使用“\\”;您可以在其中使用“/”,操作系统非常满意; cmd.exe 不喜欢使用斜杠而不是反斜杠。

模拟环境

WFM 下面的代码 - 适用于我(测试环境:MacOS X 10.6.5、Perl 5.13.4)。我从上一个问题中创建了一个文件“data.file”。我创建了子目录'safe'、'src'和'dst',并在'safe'中创建了空文件'filename2.tif'、'filename4.tif'、'filename6.tif'、'filename8.tif'。然后我将文件从“安全”链接到“src”,这样我就可以轻松地重新运行脚本,尽管它取消了输入文件的链接。

ln safe/* src

我还创建了一个脚本“转换器”:

echo "$0 $@"

示例输出

程序的输出是:

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

代码重构

#!/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 ($!)";
    }
}

注意事项

  • 在删除文件之前检查转换是否成功 (system)。
  • 检查unlink 是否成功。
  • 在错误消息中包含 Perl 错误信息“$!”。
  • 使用“use Carp;”和carpcroak 而不是warndie
  • 函数 get_file_list() 用于获取文件列表 - 只需一次。
  • 该函数使用词法文件句柄$file 而不是FILE
  • 它还使用了open的三参数形式,这是最可靠的形式。
  • 它还使用低优先级“或”连接词而不是“||”。 (在上下文中,open 周围有括号,“||”是正确的;如果您在重写中省略括号,则“或”是必要的。)
  • 当响应为“不继续”时,代码会提前退出。
  • foreach 循环迭代文件列表。
  • exit 的显式状态为 0(成功)。

【讨论】:

  • 调试循环也没有运行,所以这不是主要问题。
  • 非常感谢您的帮助,乔纳森。我已经用我当前的输出和我的所有代码更新了主要问题,而不仅仅是 sn-ps。它似乎挂在同一个地方,并且我测试了您的原始代码并且它在我的程序之外工作 - 与我发布的原始代码相同;我的代码有效,但是一旦我将它放入我的程序中,它就开始挂在同一个地方。也许我在某个地方遗漏了一些我看不到的东西。我正在使用带有 EPIC 的 Eclipse,根据 Eclipse/EPIC,我的源代码中没有警告/错误。
  • @drewrockshard:我查看了您在顶部粘贴的修改后的代码……但看不出问题出在哪里。我中和了所有批处理文件代码和与配置相关的代码等(有一些小问题,例如重复解析块)。禁用所有这些后,我基本上可以看到我发布的输出。因此,您将需要使用内置 Perl 调试器或添加跟踪打印语句来确定代码中的哪些步骤挂起。
  • 我还是不明白为什么会这样。您创建的任何代码都没有引用新代码,所以我不确定为什么运行程序的“主”代码会导致问题。就像我放入新代码一样,现在新代码停止正常工作。它唯一挂在“提问”上的地方,它不输出任何信息。当我在 get_files_list($spcl_log); 之后添加 print $spcl_files[0]; 时,请查看我的新输出(主要问题)声明。
【解决方案3】:

好吧,你显然没有从&lt;FILE&gt; 那里得到任何回报。 也许您在某处更改了输入记录分隔符 ($/)?

要进行调查,请将 for 循环扩展到:

for (my $i = 0 ; $i < 5 ; $i++) {
    my $dummy = <FILE>;
    print $dummy;
}

这应该让你很好地了解这里发生了什么。

此外,请考虑以数组 (my @lines = &lt;FILE&gt;;) 读取文件,因为您多次使用该信息。

【讨论】:

  • 添加print $dummy; 执行代码,会出现以下错误:Use of uninitialized value in print at compileTiffInfo.pl。错误发生在我添加打印语句的那一行。
  • 好的,所以文件有问题。 a) 使用三操作数版本的 open:open(FILE, '&lt;', $spcl_log) 来确保您确实在阅读。 b) 将文件重命名/复制到其他位置并更改路径以确保没有权限/路径问题。 c) 仔细检查文件中是否确实存在某些内容。
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2011-05-12
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多