Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Bring out your Old Perl Code

by Gavin (Canon)
on Dec 18, 2007 at 21:23 UTC ( #657744=perlmeditation: print w/ replies, xml ) Need Help??

Prompted by Perl being 20 years young today and reading an old Selected Best Node Last Script. What now? by Acolyte Vintage 2002, who mentions a love hate relationship with an old Perl script.

Set me looking for some early code examples, hopefully from the very late 80's that were still working today.

ajt mentions and old script here Re(7): The Case for Learning Perl that "allows a remote user to arbitrarily view any file on the server", but gives no indication of its age.

There appear to be scripts still around and working from the mid 90ís, but I haven't been able to find anything earlier.

I'm sure other Monks know better!

There must be a gem still in existence from the early days, what's the oldest bit of Perl you love/hate still working for its living?

Comment on Bring out your Old Perl Code
Re: Bring out your Old Perl Code
by chromatic (Archbishop) on Dec 18, 2007 at 21:34 UTC

    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.

      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.
Re: Bring out your Old Perl Code
by technojosh (Priest) on Dec 18, 2007 at 22:24 UTC
    There was a similar (or at least helpful) post in SoPW earlier today:

    Does somebody have a PERL 0 (or 1.0) code

    However, this is an educational-only thread for me, I haven't ever used anything prior to Perl 5...

Re: Bring out your Old Perl Code
by FunkyMonk (Canon) on Dec 18, 2007 at 22:51 UTC
      Very interestingly, here's the contents of the Wishlist file from that release:

      date support
      case statement
      ioctl() support
      random numbers
      directory reading via <>

      It's taken a while, but I think this list is complete now.

        directory reading via <>

        I personally believe that maybe He didn't mean the glob behaviour later given to angular brackets (along with the guessing nightmare now associated to what's inside them) but that a dirhandle in them would return directory entries. Anyway, the fact that glob() was actually put in that role tends to counter my suspect. But of course someone could put an authoritative last word here...

        --
        If you can't understand the incipit, then please check the IPB Campaign.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://657744]
Approved by kyle
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (16)
As of 2014-07-10 20:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (215 votes), past polls