s.pl: perl5.005-compatible
This commit is contained in:
parent
b247feec64
commit
4c98f7f23f
19
s.pl
19
s.pl
|
@ -1,7 +1,7 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
#use warnings; # Old perl
|
||||
$|++;
|
||||
|
||||
my$dir = shift @ARGV;
|
||||
|
@ -9,22 +9,23 @@ $dir =~ /^(\/.*)\/([^\/]+)$/ or die( "{proc: \"s\", error: \"invalid_path_expres
|
|||
($dir, my$fexpr) = ($1, $2);
|
||||
|
||||
chdir( $dir) or die( "{proc: \"s\", error: \"change_directory\", value: \"$dir\", message: \"$!\"}\n");
|
||||
opendir( my$dh, '.') || die "{proc: \"s\", error: \"dir_not_found\", message: \"Directory not found.\"}\n";
|
||||
while( my$filename = readdir( $dh)) {
|
||||
opendir( DH, '.') || die "{proc: \"s\", error: \"dir_not_found\", message: \"Directory not found.\"}\n";
|
||||
while( my$filename = readdir( DH)) {
|
||||
$filename =~ /$fexpr/ or next;
|
||||
-f $filename or next;
|
||||
print pack( 'nN/A*', 1, $filename);
|
||||
print pack( 'nNA*', 1, length($filename), $filename);
|
||||
print STDERR "{proc: \"s\", action: \"open\", file: \"$filename\"}\n";
|
||||
open F, $filename;
|
||||
read STDIN, my$length, 4; # Was wenn < 4 ?
|
||||
my( $length, $r);
|
||||
read STDIN, $length, 4; # Was wenn < 4 ?
|
||||
$length = unpack 'N', $length;
|
||||
seek F, $length, 0;
|
||||
while( read( F, my$r, 2040)) {
|
||||
print pack( 'nN/A*', 2, $r);
|
||||
while( read( F, $r, 2040)) {
|
||||
print pack( 'nNA*', 2, length($r), $r);
|
||||
}
|
||||
print STDERR "{proc: \"s\", action: \"close\", file: \"$filename\"}\n";
|
||||
close F;
|
||||
}
|
||||
closedir $dh;
|
||||
closedir DH;
|
||||
print STDERR "{proc: \"s\", exit: 0}\n";
|
||||
exit(0);
|
||||
exit( 0);
|
||||
|
|
Loading…
Reference in a new issue