RE: [code-review] list scope

"Hodges, Paul" <Paul.Hodges-zv7RHi0Am8a1Z/[email protected]> Fri, 12 Sep 2003 16:45:53 -0500
Newsgroups gmane.comp.lang.perl.code-review-ladder
Message-ID <9C375DDD9B669243A2D78FCD607E894003E4FC4E@bremo-jg>
Ok, here's what I have so far.
First, the edited module code Class.pm:
=======================================
package Class;
use strict;
use warnings;
use Carp 'confess';

my $acctlayout = $main::acctlayout; # altered these from literals
my @acctfields = @main::acctfields; # to protect myself from the 
my $linelayout = $main::acctlayout; # company's proprietary police.
my @linefields = @main::acctfields;
my $usg_layout = $main::acctlayout;
my @usg_fields = @main::acctfields;

our ($rec,@block,%self);#package globals for speed(?),readability aliasing
our @usg  = ('usg',@usg_fields);        # fields to emplty on new line
our @clean = (@usg,'line',@linefields); # list to empty on new account

sub import { my ($cls,%arg) = @_;
    return 1 unless %arg;
    for (keys %arg) { my $flag = uc;
                eval "\$Class::$flag = '$arg{$_}'";
                confess $@ if $@;
        }
}

sub open { my $self = shift;
    local $_ = shift or confess "invalid usage";
    if (-e) {                             # a real file to open
        confess "invalid file" unless -e && -f && -r && -s;
        $_ = -T() ? $_ : "gzcat $_|";     # binary must be compressed
    } else {                              # not an extant file
        unless (/[|]\s*$/) {              # an explicit pipe
            if (ref && "GLOB" eq ref) {   # a preopened globref
                $self->{_fh} = $_;        # just use it
                $self->{_src} = "DUP:$_"; # note it
            } else {                      # defaulting with STMM?
                use BaseFile ':all';      # IHL to locate datafiles
                $_ = archived BaseFile local => $_
                     or confess "invalid usage";
            }
        }
    }
    unless ($self->{_fh}) {               # unless dup'd
        CORE::open my $fh, $self->{_src} = $_;
        $self->{_fh} = $fh or confess "$_:$!";
    }
    $self;
}

sub source { $_[0]->{_src} }

sub new {
    my $self = bless {}, shift;    # create the new object
    $self->open(@_) if @_;         # open any requested stream
    $self->{_block_ndx} = 0;       # initialize record index pointer
    $self->{rec} = '';             # preset rec to defined but false
    $self;                         # return new object
}

sub blockread { my ($self,$buf) = @_; # globals better here?
    my $read = read($self->{_fh},$buf,1105920) or return;
    [ split /\r\n/, $buf ] ;
}

sub nextrec { *self = $_[0];
    *block  = $self{_recBlockBuffer} ||= $_[0]->blockread || return;
    my $ndx = $self{_block_ndx}++;
    if ($ndx > $#block) {
        *block = $self{_recBlockBuffer} = $_[0]->blockread || return; 
        $ndx = $self{_block_ndx} = 0; # point at the fresh data
    }
    $rec = $self{rec} = $block[$ndx];
    parse($_[0],$rec) unless $Class::NOPARSE;
    $rec;
}

sub parse { no warnings;           # to quiet > & == on 0A's
    (*self,$rec) = @_;             # alias to simplify lookup chains
    my $rt = substr($rec||=$self{rec},0,2) or confess "invalid usage";
    if ($rt > 1) {                 # all greater than 01 is usage
        @self{@usg_fields} = unpack $usg_layout, $self{usg} = $rec;
    } elsif($rt == 1)   {          # 01 records are line data
        @self{@usg}        = ();   # line cleans out previous usage
        @self{@linefields} = unpack $linelayout, $self{line} = $rec;
    } else {                       # 0[0A] is account data
        @self{@clean}      = ();   # account cleans out line & usage data
        @self{@acctfields} = unpack $acctlayout, $self{acct} = $rec;
    }
    $rec;
}

sub readacct { *self   = $_[0];
    *block  = $self{_recBlockBuffer} ||= $_[0]->blockread || return [];
    my $ndx = $self{_block_ndx}      ||=  0; 
    SCAN:{ $ndx++ until not $block[$ndx] or $ndx and $block[$ndx] =~
/^0[0A]/;
        unless ($block[$ndx]) {
            last unless $ndx < push @block, @{$_[0]->blockread||[]};
            redo SCAN; # continue until we have the whole account
        }
    }
    $self{_block_ndx}      = 0; # reset to top
    [ splice @block, 0, $ndx ]; # chop off acct
}

sub iRecType { no warnings; # could be "0A", which is a valid 0 rectype
    int($_[0]->{rt});
}

our $AUTOLOAD; # accessors only created if needed
sub  AUTOLOAD { (my $field = $AUTOLOAD) =~ s/^.*:://; # strip namespace
  confess "invalid field '$field' requested" 
    unless grep { /$field/ } (@clean,@acctfields,'rec');
  my $code = qq{
    sub $AUTOLOAD { my \$self = shift;
        \@_ ? \$self->{$field}=shift : \$self->{$field};
    }
  };
  eval $code; confess $@ if $@;
  goto &$AUTOLOAD;
}

1;

================================================================
Here's two scripts that use it -- the "standard" approach:
================================================================
use Class;
my $obj = new Class "infile.Z" or die "oops $!";
my($a,$l,$c) = (0)x3;
while ($obj->nextrec) {
        my $rt = $obj->iRecType;
        if ($rt > 1) { $c += $obj->msg if $obj->some_ind eq "1";
        } elsif($rt) { $l += $obj->lines;
        } else       { $a++;
    }
}
print "Accts:\t$a\nLines:\t$l\nSome: \t$c\n",
          "\nLines/Acct:\t", $l/$a,
          "\nSome/Acct: \t", $c/$a,
          "\nSome/Line: \t", $c/$l,
          "\n";
====================================================================
and the one that reads an account at a time....which, I found, 
was actually faster than the one above, probably from reduced calls:
====================================================================
use Class;
my $obj = new Class "infile.Z" or die "oops $!";
my($a,$l,$c) = (0)x3;
our @acct = @{$obj->readacct};
while (@acct) { $a++;
    $obj->parse($acct[0]); # faster even *with* this superfluous line!
    for my $rec (@acct[1..$#acct]) { $obj->parse($rec);
        if ($rec =~ /^01/) { $l += $obj->lines;
        } else             { $c += $obj->msg if $obj->some_ind eq "1";
        }
    }
    *acct = $obj->readacct;
}
print "Accts:\t$a\nLines:\t$l\nSome: \t$c\n",
          "\nLines/Acct:\t", $l/$a,
          "\nSome/Acct: \t", $c/$a,
          "\nSome/Line: \t", $c/$l,
          "\n";
================================================================

infile.Z is 139,425,713 bytes 84% compressed, 873,406,746 uncompressed
according to gzip -lv.
Reading this file takes over two hours no matter which version I used,
though an Inline::C variant skims it in under a half-hour if I don't do much
more than these do. Brian Ingerson's Inline.pm is a godsend, but the
configuration on our new systems discourages it, not to mention that this is
production code and last I heard inline was still a little pseudo-beta? I've
never seen it fail, but this needs to be solid. If it matters, these are all
UNIX systems.

Any streamlining suggestions are welcome, though I have some odd
constraints.....

And again, thanks to all for your time and input. I look forward to a chance
to return the favor.


*****
"The information transmitted is intended only for the person or entity to
which it is addressed and may contain confidential, proprietary, and/or
privileged material.  Any review, retransmission, dissemination or other use
of, or taking of any action in reliance upon, this information by persons or
entities other than the intended recipient is prohibited.  If you received
this in error, please contact the sender and delete the material from all
computers."