view release on metacpan or  search on metacpan

Tools.pm  view on Meta::CPAN

 (
   {Name=>'Alice', Age=>20,    Gender=>'F'},
   {Name=>'Bob',   Age=>30,    Gender=>'M'},
   {Name=>'Eve',   Age=>undef, Gender=>'F'},
 );

=head2 h2a

B<Input:> array of hashes

B<Output:> array of arrays

Opposite of L</a2h>

=cut

sub a2h {
    my @col=@{shift@_};
    map { my%h;@h{@col}=@$_;\%h} @_;
}

sub h2a {
    my %c;
    map $c{$_}++, keys%$_ for @_;
    my @c=sort{$c{$a}<=>$c{$b} or $a cmp $b}keys%c;
    (\@c,map[@$_{@c}],@_);
}

=head1 COMPRESSION

L</zipb64>, L</unzipb64>, L</zipbin>, L</unzipbin>, L</gzip>, and L</gunzip>
compresses and uncompresses strings to save space in disk, memory,
database or network transfer. Trades time for space. (Beware of wormholes)

=head2 zipb64

Compresses the input (text or binary) and returns a base64-encoded string of the compressed binary data.
No known limit on input length, several MB has been tested, as long as you've got the RAM...

B<Input:> One or two strings.

First argument: The string to be compressed.

Second argument is optional: A I<dictionary> string.

B<Output:> a base64-kodet string of the compressed input.

The use of an optional I<dictionary> string will result in an even
further compressed output in the dictionary string is somewhat similar
to the string that is compressed (the data in the first argument).

If x relatively similar string are to be compressed, i.e. x number
automatic of email responses to some action by a user, it will pay of
to choose one of those x as a dictionary string and store it as
such. (You will also use the same dictionary string when decompressing
using L</unzipb64>.

The returned string is base64 encoded. That is, the output is 33%
larger than it has to be.  The advantage is that this string more
easily can be stored in a database (without the hassles of CLOB/BLOB)
or perhaps easier transfer in http POST requests (it still needs some
url-encoding, normally). See L</zipbin> and L</unzipbin> for the
same without base 64 encoding.

Example 1, normal compression without dictionary:

  $txt = "Test av komprimering, hva skjer? " x 10;  # ten copies of this norwegian string, $txt is now 330 bytes (or chars rather...)
  print length($txt)," bytes input!\n";             # prints 330
  $zip = zipb64($txt);                              # compresses
  print length($zip)," bytes output!\n";            # prints 65
  print $zip;                                       # prints the base64 string ("noise")

  $output=unzipb64($zip);                              # decompresses
  print "Hurra\n" if $output eq $txt;               # prints Hurra if everything went well
  print length($output),"\n";                       # prints 330

Example 2, same compression, now with dictionary:

  $txt = "Test av komprimering, hva skjer? " x 10;  # Same original string as above
  $dict = "Testing av kompresjon, hva vil skje?";   # dictionary with certain similarities
                                                    # of the text to be compressed
  $zip2 = zipb64($txt,$dict);                          # compressing with $dict as dictionary
  print length($zip2)," bytes output!\n";           # prints 49, which is less than 65 in ex. 1 above
  $output=unzipb64($zip2,$dict);                       # uses $dict in the decompressions too
  print "Hurra\n" if $output eq $txt;               # prints Hurra if everything went well


Example 3, dictionary = string to be compressed: (out of curiosity)

  $txt = "Test av komprimering, hva skjer? " x 10;  # Same original string as above
  $zip3 = zipb64($txt,$txt);                           # hmm
  print length($zip3)," bytes output!\n";           # prints 25
  print "Hurra\n" if unzipb64($zip3,$txt) eq $txt;     # hipp hipp ...

zipb64() and zipbin() is really just wrappers around L<Compress::Zlib> and C<inflate()> & co there.

=cut

sub zipb64 {
  require MIME::Base64;
  return MIME::Base64::encode_base64(zipbin(@_));
}


=head2 zipbin

C<zipbin()> does the same as C<zipb64()> except that zipbin()
does not base64 encode the result. Returns binary data.

See L</zip> for documentation.

=cut

sub zipbin {
  require Compress::Zlib;
  my($data,$dict)=@_;
  my $x=Compress::Zlib::deflateInit(-Dictionary=>$dict||'',-Level=>Compress::Zlib::Z_BEST_COMPRESSION()) or croak();
  my($output,$status)=$x->deflate($data); croak() if $status!=Compress::Zlib::Z_OK();
  my($out,$status2)=$x->flush(); croak() if $status2!=Compress::Zlib::Z_OK();
  return $output.$out;

Tools.pm  view on Meta::CPAN

  return Digest::MD5::md5_hex($$fn) if ref($fn) eq 'SCALAR';
  croak "md5sum: $fn is a directory (no md5sum)" if -d $fn;
  open my $FH, '<', $fn or croak "Could not open file $fn for md5sum() $!";
  binmode($FH);
  my $r = eval { Digest::MD5->new->addfile($FH)->hexdigest };
  croak "md5sum on $fn failed ($@)\n" if $@;
  $r;
}

=head2 which

Returns the first executable program in $ENV{PATH} paths (split by : colon) with the given name.

 echo $PATH
 perl -MAcme::Tools -le 'print which("gzip")'      # maybe prints /bin/gzip

=head2 read_conf

B<First argument:> A file name or a reference to a string with settings in the format described below.

B<Second argument, optional:> A reference to a hash. This hash will have the settings from the file (or stringref).
The hash do not have to be empty beforehand.

Returns a hash with the settings as in this examples:

 my %conf = read_conf('/etc/your/thing.conf');
 print $conf{sectionA}{knobble};  #prints ABC if the file is as shown below
 print $conf{sectionA}{gobble};   #prints ZZZ, the last gobble
 print $conf{switch};             #prints OK here as well, unsectioned value
 print $conf{part2}{password};    #prints oh:no= x

File use for the above example:

 switch:    OK       #before first section, the '' (empty) section
 [sectionA]
 knobble:   ABC
 gobble:    XYZ      #this gobble is overwritten by the gobble on the next line
 gobble:    ZZZ
 [part2]
 password:  oh:no= x  #should be better
 text:      { values starting with { continues
              until reaching a line with }

Everything from # and behind is regarded comments and ignored. Comments can be on any line.
To keep a # char, put a \ in front of it.

A C< : > or C< = > separates keys and values.  Spaces at the beginning or end of lines are
ignored (after removal of #comments), as are any spaces before and after : and = separators.

Empty lines or lines with no C< : > or C< = > is also ignored. Keys and values can contain
internal spaces and tabs, but not at the beginning or end.

Multi-line values must start and end with { and }. Using { and } keep spaces at the start
or end in both one-line and multi-line values.

Sections are marked with C<< [sectionname] >>.  Section names, keys and values is case
sensitive. C<Key:values> above the first section or below and empty C<< [] >> is placed
both in the empty section in the returned hash and as top level key/values.

C<read_conf> can be a simpler alternative to the core module L<Config::Std> which has
its own hassles.

 $Acme::Tools::Read_conf_empty_section=1;        #default 0 (was 1 in version 0.16)
 my %conf = read_conf('/etc/your/thing.conf');
 print $conf{''}{switch};                        #prints OK with the file above
 print $conf{switch};                            #prints OK here as well

=cut

our $Read_conf_empty_section=0;
sub read_conf {
  my($fn,$hr)=(@_,{});
  my $conf=ref($fn)?$$fn:readfile($fn);
  $conf=~s,\s*(?<!\\)#.*,,g;
  my($section,@l)=('',split"\n",$conf);
  while(@l) {
    my $l=shift@l;
    if( $l=~/^\s*\[\s*(.*?)\s*\]/ ) {
      $section=$1;
      $$hr{$1}||={};
    }
    elsif( $l=~/^\s*([^\:\=]+?)\s*[:=]\s*(.*?)\s*$/ ) {
      my $ml=sub{my$v=shift;$v.="\n".shift@l while $v=~/^\{[^\}]*$/&&@l;$v=~s/^\{(.*)\}\s*$/$1/s;$v=~s,\\#,#,g;$v};
      my $v=&$ml($2);
      $$hr{$section}{$1}=$v if length($section) or $Read_conf_empty_section;
      $$hr{$1}=$v if !length($section);
    }
  }
  %$hr;
}
#  my $incfn=sub{return $1 if $_[0]=~m,^(/.+),;my$f=$fn;$f=~s,[^/]+$,$_[0],;$f};
#    s,<INCLUDE ([^>]+)>,"".readfile(&$incfn($1)),eg; #todo


=head2 openstr

                                            # returned from openstr:
  open my $FH, openstr("fil.txt")  or die;  # fil.txt
  open my $FH, openstr("fil.gz")   or die;  # zcat fil.gz |
  open my $FH, openstr("fil.bz2")  or die;  # bzcat fil.bz2 |
  open my $FH, openstr("fil.xz")   or die;  # xzcat fil.xz |
  open my $FH, openstr(">fil.txt") or die;  # > fil.txt
  open my $FH, openstr(">fil.gz")  or die;  # | gzip > fil.gz
  open my $FH, openstr(">fil.bz2") or die;  # | bzip2 > fil.bz2
  open my $FH, openstr(">fil.xz")  or die;  # | xz    > fil.bz2

Environment variable PATH is used. So in the examples above, /bin/gzip
is returned instead of gzip if /bin is the first directory in
$ENV{PATH} containing an executable file gzip. Dirs /usr/bin, /bin and
/usr/local/bin is added to PATH in openstr(). They are checked even if
PATH is empty.

See also C<writefile()> and C<readfile()> for automatic compression and decompression using C<openstr>.

=cut

our @Openstrpath=(grep$_,split(":",$ENV{PATH}),qw(/usr/bin /bin /usr/local/bin));
our $Magic_openstr=1;
sub openstr_prog { @Openstrpath or return $_[0];(grep -x$_, map "$_/$_[0]", @Openstrpath)[0] or croak"$_[0] not found" }
sub openstr {
  my($fn,$ext)=(shift()=~/^(.*?(?:\.(t?gz|bz2|xz))?)$/i);