Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

write/format hash data to a scalar in multi-line columns

by runrig (Abbot)
on Jul 18, 2001 at 22:22 UTC ( #97812=snippet: print w/replies, xml ) Need Help??
Description: I needed to format some data for email confirmation messages, and needed to save the output in a variable instead of sending it straight to a file handle, plus I needed a variable format. After a detour through considering IO::Scalar (write will not work on tied file handles) and a suggestion to use IPC::Open2 (interesting, but yuck), I found what I needed in perlfaq5 and a re-read of perlform in the form of the '~~' format attribute (you won't find it by searching for '~~' either), the formline function, and the $^A variable.

This was good enough for me, if you want to combine left and right justification of fields, you can set up a hash of field names, and that's left as an exercise :)

my %formats; # cache for format types

sub format_items {
 # Key for what 'type' of format we have
 my $type = shift;
 # Data to format in a list of hashrefs
 my $items = shift;

 # Get cached format or construct new one
 # We could just use the '$line' argument as the hash
 # key, but I'd rather label them, and it fit better with
 # what I was doing at the time.
 my $fmt = $formats{$type} || do {
  # format line is in form "key1:length1;key2:length2;etc."
  my $line = shift;
  my %lengths = map { split /:/ } my @fields = split /;/, $line;
  s/:.*// for @fields;
  my $picture = join " ", map { '^' . ("<" x ($lengths{$_}-1))
  } @fields;
  $picture .= "~~\n";
  $formats{$type} = [ \@fields, $picture ];
 };
 my ($fields, $picture) = @$fmt;
 $^A = '';
 for my $href (@$items) {
  s/^\s+// for values %$href;
  # Warning: formline is destructive to the data in href
  # when using '~~' and '^' :-0
  # But I don't need the data after this anyway :-)
  # If you have a lot of records, you might want to
  # process and return one record at a time.
  formline($picture, @$href{@$fields});
 }
 return $^A;
}

my @data = (
 {quantity=>1, description=>'Super Widget', price=>'$29.95'},
 {quantity=>1,
  description=>'Really Great Product With A Real Long Description',
  price=>'$39.95'},
);

# Please don't blame me for the format spec :)
my $format = "quantity:4;description:20;price:9";
my $formatted = format_items('NEW_ORDER', \@data, $format);
print $formatted;
print "\n";

@data = (
 {quantity=>1, description=>'Super Widget', price=>'$29.95',
  status=>'SHIPPED'},
 {quantity=>1,
  description=>'Really Great Product With A Real Long Description',
  price=>'$39.95', status=>'SHIPPED'},
);

$format = "quantity:4;description:20;price:9;status:10";
$formatted = format_items('SHIPPED_ORDER', \@data, $format);
print $formatted;

# OUTPUTS
1    Super Widget         $29.95
1    Really Great Product $39.95
     With A Real Long 
     Description
                          
1    Super Widget         $29.95    SHIPPED
1    Really Great Product $39.95    SHIPPED
     With A Real Long
     Description
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: snippet [id://97812]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2023-12-01 07:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?