[comp.lang.perl] perl pipe dreams

sharon@jpl-devvax.JPL.NASA.GOV (Sharon Hopkins) (02/09/91)

When my alarm went off this morning, it woke me out of a very frustrating
dream in which I had this string of characters I was trying to split into
an array, only some of the elements kept overlapping.  Unfortunately, I
only learned subroutines on Monday, and haven't learned split yet, but my
subconscious seemed to think I ought to have known how to do it.  (I'm
told there is at least one Way To Do It, but I haven't had a chance to
try it yet.)  Do other people dream in perl?   :-)

I'm pretty sure I know what brought on this particular nightmare, however:

I have to get reports out of Sybase now and again, and several of the fields I
want are really long, which means I get nasty line wraps, and reports that
shouldn't fill one screen take up two or three.  All I wanted was a nice,
pretty output format.  (ISQL lets you select a substring of a particular field,
but loses the headers for all the columns you crop that way).  So, I asked
Larry what I needed to do to squeeze my fields so that I would never get a line
of output that was more than 80 characters across.  A simple split on white
space wouldn't work because several fields that are allocated twenty or thirty
characters currently only have a few characters in them.  (Example:  the field 
"archiveTime" allows 30 or so characters, but is currently NULL in all the
records, which leaves lots of wasted white space).  Also, I didn't want to
have to specify a different output format for every set of fields I happened
to want to select.

By about 1:00 (this morning) Larry had come up with the following (which was
a lot less readable before he fixed it to work under patchlevel 40, which is
as far as the machines I wanted to run on had got):


(Note:  It's called "squish", and expects a line of column headers, then
a line of dashes (with breaks between columns), then the rest of the stuff
that belongs in those columns; Larry says it's okay to post it...  :-)

----------------------------- --------------- ------------------------------

#!/usr/bin/perl

# Get first nonblank line

while (<>) {
    last unless /^\s*$/;
}
$fieldnames = $_;

# Get line with minuses

while (<>) {
    last if /--/;
}
chop;

# make unpack template

$template = $_;
$template =~ s/-+/"A" . length($&)/eg;
$template =~ s/ /x/g;
$template =~ s/x+$//;
$template =~ s/\d+$/*/;
print $template,"\n" if $debugging;
$fields = $template =~ tr/A/A/;		# count number of fields

# make new minuses line to fit in 80 columns

$min = $_;
$origminuses = $_;
$string = '-' x length($min);
while (length($min) > 80) {
    $min =~ s/-$string/$string/ || $string =~ s/-//;
}
print $min,"\n" if $debugging;
$minuses = $min;

# make a picture line for format

$min =~ tr/-/Q/;
$min =~ s/\bQ/@/g;
$min =~ tr/Q/</;
print $min,"\n" if $debugging;
$picture = $min;

# Make list of array references

for (0..$fields-1) {
    $fldlist .= "\$F[$_],";
}
chop($fldlist); #delete comma

# Generate the format at run-time using eval

$format = <<"EndOfFormat";
format STDOUT =
$picture
$fldlist
.
EndOfFormat
print $format if $debugging;
eval $format;

$_ = $fieldnames;
&DOLINE;
$_ = $origminuses;
&DOLINE;

while (<>) {
    last if /rows affected/;
    &DOLINE;
}

sub DOLINE {
    @F = ();
    eval '@F = unpack($template, $_)';
    write STDOUT;
}


----------------------------- ---------------- -----------------------------

Sharon Hopkins
sharon@jpl-devvax.Jpl.Nasa.Gov

	    "comp.lang.perl -- Distributed Regression Testing"