Vladimir Lemberg wrote:
Hi All,

Could you help me to solve following problem:

I need to execute tkl script with two arguments (input file and output file) 
within my Perl script:

#!/usr/bin/perl -w
use strict;
use File::Basename;

my @gdflist = `find . -name *.gdf`;
my $gdf_number = scalar(@gdflist);
my $counter = 0;

foreach my $gdf (@gdflist){
my $base = basename $gdf;
my $path = dirname $gdf;
$base =~ s/(.*)(\.)/$1$2/;
chomp($gdf);
my $arg1 = $gdf;
my $arg2 = "$path/$1_patched.gdf";
system "patch_teleatlas_gdf.tcl $arg1 $arg2" or die "patch_teleatlas_gdf.tcl is not working properly";
$counter ++;
print "\{$gdf\}:PATCHED($counter of $gdf_number)";
}


The problem that I'm receiving the die message "patch_teleatlas_gdf.tcl is not working properly" but then I manually assign arguments, Tcl script works with no problem.

my arg1 = "./CSK/cansk47.gdf";
my arg2 = "./CSK/cansk47_patched.gdf";
system "patch_teleatlas_gdf.tcl $arg1 $arg2" or die "patch_teleatlas_gdf.tcl is not 
working properly";

Any ideas? Should i use execvp(3) instead?

C<system> returns the exit code of the program executed. Most programs return 0 (zero) on success. However, zero is treated as a false value in perl, so your C<or> condition above is executed when the tcl script succeeds. You need to compare the result of system to zero to determine success:


system(...) == 0 or die;

A more perlish version of your script might look like (untested):

#!/usr/bin/perl

use strict;
use warnings;

use File::Find;
use File::Spec;

my $script = 'tickle.tcl';
my $count = 0;

find( sub {
    return unless /\.gdf/ && -f;

    (my $base = $_) =~ s/\.[^.]+$//;

my $src = $File::Find::name;
my $dest = File::Spec->catfile( $File::Find::dir, "${base}_patched.gdf" );


    system( $script, $src, $dest ) == 0
        or die "error code $? returned: $!";

    ++$count;
}, 'downloads' );

print "$count files patched\n";

__END__


-- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>




Reply via email to