in reply to Bring out your Old Perl Code

The Punie language in Parrot includes test files from early Perl 1 releases. I've made a couple of those run with various incarnations of Punie and I've seen some of them fail for odd reasons. They're 20 years old.

Replies are listed 'Best First'.
Re^2: Bring out your Old Perl Code
by blazar (Canon) on Dec 29, 2007 at 15:00 UTC

    I personally believe one may also play with some code from http://dev.perl.org/perl1/dist/example.gz (which I found mentioned in a recent post.) Actually it would be interesting to rewrite equivalent code in pre-5.10 Perl 5 code, in 5.10 if it has some advantage, and perhaps in Perl 6 if it is interesting. I'm skipping gsh and trying some of the shorter examples:

    #!/bin/perl open(goners,"find . -mtime +14 -print|"); while (<goners>) { chop; unlink; }

    Ah! Larry, Larry! You must be a n00b ;) Don't we suggest the use of File::Find and relatives all the time?

    #!/usr/bin/perl use strict; use warnings; use File::Find; use 5.010; find { no_chdir => 1, wanted => sub { unlink if -f -M > 14 } }, '.'; __END__

    (I don't think you want to unlink directories, anyway, don you?)

    #!/bin/perl die "Usage: euthanasia directory days" unless $#ARGV == 1; ($dir, $days) = @ARGV; # assign array to list of variables die "Can't find directory $dir" unless chdir $dir; open(goners,"find . -mtime +$days -print|") || die "Can't run find +"; while (<goners>) { chop; unlink; }
    #!/usr/bin/perl use strict; use warnings; use File::Find; use File::Basename; use 5.010; BEGIN { my $name = basename $0; sub USAGE () { "Usage: $name <directory> <days>\n" } } die USAGE unless @ARGV == 2; my ($dir, $days) = @ARGV; find { no_chdir => 1, wanted => sub { unlink if -f -M > $days } }, $dir; __END__

    And now, I'm half way through working on scan_df but I must get out of my house in a few minutes, so I'll complete that later...

    --
    If you can't understand the incipit, then please check the IPB Campaign.
      And now, I'm half way through working on scan_df but I must get out of my house in a few minutes, so I'll complete that later...

      I personally believe it's ready now. Please note that my rewriting of the original script reflects my own personal preferences and is in no way intended to claim that it shows the Right™ WTDI. Also double check for errors since fundamentally I only made sure that it passes -c.

      First, the original script:

      And then, the rewriting:

      #!/usr/bin/perl use strict; use warnings; use File::Basename; use Getopt::Std; my $name; BEGIN { $name = basename $0; sub USAGE () { <<".EOT"; } $name [options] Current options are: -m Assume mc300, mc500 or mc700 -h Print this help screen and exit .EOT } my %opts; getopts 'mh' => \%opts; print(USAGE), exit if $opts{h}; my $dir = '/usr/adm/private/memories'; my $olddf = 'olddf'; chdir $dir or die "[$name] Can't cd into `$dir': $!\n"; defined(my $newdf = qx/df/) or die "[$name] Can't run df: $!\n!"; my %oldused = map { my ($fs,undef,$used)=split; $fs =~ /:/ ? () : $fs => $used; } do { open my $df, '<', $olddf or die "[$name] Can't open `$olddf': $!\n +"; <$df> }; open my $df, '<', \$newdf or die "[$name] Can't open file in memory: $ +!\n"; while (<$df>) { my ($fs, $kbytes, $used, $avail, $capacity, $mounted_on) = split; next if $fs =~ /:/; my $oldused = $oldused{$fs}; next if ($oldused == $used and $capacity < 99); # inactive file +system if ($capacity >= 90) { if ($opts{m}) { substr($_,13,0) = ' ' x 8; $_ /= 2 for $kbytes, $used, $oldused, $avail; } my $diff = int($used - $oldused); $mounted_on .= ' *' if $avail < 2*$diff; next if $diff < 50 && $mounted_on eq '/'; $fs =~ s|/dev/||; $diff = '(' . ($diff >=0 ? '+' : '') . "$_)"; printf "%-8s%8d%8d %-8s%8d%7s %s\n" => $fs, $kbytes, $used, $diff, $avail, $capacity, $mounted_on; } } open my $odf, '>', $olddf or die "[$name] Can't open `$olddf': $!\n"; print $odf $newdf; __END__
      --
      If you can't understand the incipit, then please check the IPB Campaign.