Acme-Tools

 view release on metacpan or  search on metacpan

Tools.pm  view on Meta::CPAN


=head2 keysr

=head2 valuesr

=head2 eachr

=head2 joinr

In Perl versions 5.12 - 5.22 push, pop, shift, unshift, splice, keys, values and each
handled references to arrays and references to hashes just as if they where arrays and hashes. Examples:

 my $person={name=>'Gaga', array=>[1,2,3]};
 push    $person{array}  , 4;  #works in perl 5.12-5.22 but not before and after
 push @{ $person{array} }, 4;  #works in all perl5 versions
 pushr   $person{array}  , 4;  #use Acme::Tools and this should work in perl >= 5.8
 popr    $person{array};       #returns 4

=cut

sub pushr    { push    @{shift()}, @_ } # ?    ($@)
sub popr     { pop     @{shift()}     }
sub shiftr   { shift   @{shift()}     }
sub unshiftr { unshift @{shift()}, @_ }
sub splicer  { @_==1 ? splice( @{shift()} )
              :@_==2 ? splice( @{shift()}, shift() )
              :@_==3 ? splice( @{shift()}, shift(), shift() )
              :@_>=4 ? splice( @{shift()}, shift(), shift(), @_ ) : croak }
sub keysr    { ref($_[0]) eq 'HASH' ? keys(%{shift()}) : keysr({@{shift()}})  } #hm sort(keys%{shift()}) ?
sub valuesr  { values( %{shift()} )    }
sub eachr    { ref($_[0]) eq 'HASH'  ? each(%{shift()})
             #:ref($_[0]) eq 'ARRAY' ? each(@{shift()})  # perl 5.8.8 cannot compile each on array! eval?
		   :                        croak("eachr needs hashref or arrayref got '".ref($_[0])."'") }
sub joinr    {join(shift(),@{shift()})}
#sub mapr    # som scala: hvis map faar subref se kalles den sub paa hvert elem og resultatet returneres

#sub eachr    { each(%{shift()}) }

=head2 pile

B<Input:> a pile size s and a list

B<Output:> A list of lists of length s or the length of the remainer in
the last list. Piles together the input list in lists of the given size.

 my @list=(1,2,3,4,5,6,7,8,9,10);
 my @piles = pile(3, @list );        # ([1,2,3], [4,5,6], [7,8,9], [10])
 my $i=0;
 my @piles = parta {$i++/3} @list;   # same as above pile(3, @list)

=cut

sub pile { my $size=shift; my @r; for (@_){ push@r,[] if !@r or 0+@{$r[-1]}>=$size; push @{$r[-1]}, $_ } @r }

=head2 aoh2sql

  my @oceania=(
    {Area=>undef,   Capital=>'Pago Pago',        Code=>'AS', Name=>'American Samoa',                  Population=>54343},
    {Area=>7686850, Capital=>'Canberra',         Code=>'AU', Name=>'Australia',                       Population=>22751014},
    {Area=>undef,   Capital=>'West Island',      Code=>'CC', Name=>'Cocos (Keeling) Islands',         Population=>596},
    {Area=>240,     Capital=>'Avarua',           Code=>'CK', Name=>'Cook Islands',                    Population=>9838},
    {Area=>undef,   Capital=>'Flying Fish Cove', Code=>'CX', Name=>'Christmas Island',                Population=>1530},
    {Area=>18270,   Capital=>'Suva',             Code=>'FJ', Name=>'Fiji',                            Population=>909389},
    {Area=>702,     Capital=>'Palikir',          Code=>'FM', Name=>'Micronesia, Federated States of', Population=>105216},
    {Area=>549,     Capital=>'Hagatna (Agana)',  Code=>'GU', Name=>'Guam',                            Population=>161785},
    {Area=>811,     Capital=>'Tarawa',           Code=>'KI', Name=>'Kiribati',                        Population=>105711},
    {Area=>181.3,   Capital=>'Majuro',           Code=>'MH', Name=>'Marshall Islands',                Population=>72191},
    {Area=>19060,   Capital=>'Noumea',           Code=>'NC', Name=>'New Caledonia',                   Population=>271615},
    {Area=>undef,   Capital=>'Kingston',         Code=>'NF', Name=>'Norfolk Island',                  Population=>2210},
    {Area=>21,      Capital=>'Yaren District',   Code=>'NR', Name=>'Nauru',                           Population=>9540},
    {Area=>260,     Capital=>'Alofi',            Code=>'NU', Name=>'Niue',                            Population=>1190},
    {Area=>268680,  Capital=>'Wellington',       Code=>'NZ', Name=>'New Zealand',                     Population=>4438393},
    {Area=>undef,   Capital=>'Papeete',          Code=>'PF', Name=>'French Polynesia',                Population=>282703},
    {Area=>462840,  Capital=>'Port Moresby',     Code=>'PG', Name=>'Papua New Guinea',                Population=>6672429},
    {Area=>undef,   Capital=>'Adamstown',        Code=>'PN', Name=>'Pitcairn',                        Population=>48},
    {Area=>458,     Capital=>'Melekeok',         Code=>'PW', Name=>'Palau',                           Population=>21265},
    {Area=>28450,   Capital=>'Honiara',          Code=>'SB', Name=>'Solomon Islands',                 Population=>622469},
    {Area=>undef,   Capital=>undef,              Code=>'TK', Name=>'Tokelau',                         Population=>1337},
    {Area=>26,      Capital=>'Funafuti',         Code=>'TV', Name=>'Tuvalu',                          Population=>10869},
    {Area=>12200,   Capital=>'Port-Vila',        Code=>'VU', Name=>'Vanuatu',                         Population=>272264},
    {Area=>undef,   Capital=>'Mata-Utu',         Code=>'WF', Name=>'Wallis and Futuna',               Population=>15500},
    {Area=>2944,    Capital=>'Apia',             Code=>'WS', Name=>'Samoa (Western)',                 Population=>197773}
  );

 print aoh2sql(\@oceania,{
    name=>'country',
    drop=>2,
   #number=>'numeric',    #default
   #varchar=>'varchar',   #default, change to varchar2 if Oracle
   #date=>'date',         #default, perhaps change to 'timestamp with time zone' if postgres
   #varchar_maxlen=>4000, #default, 4000 (used to be?) is max in Oracle
   #create=>1,            #default, use 0 to dont include create table
   #drop=>0,              #default 0: dont include drop table x; 1: drop table x; 2: drop table if exists x;
   #end=>"commit;\n",
   #begin=>"begin;\n",
   #fix_colnames=>0,
 });

Returns:

 begin;

 drop table if exists country;

 create table country (
   Area                           numeric(9,1),
   Capital                        varchar(16),
   Code                           varchar(2) not null,
   Name                           varchar(36) not null,
   Population                     numeric(9)
 );

 insert into country values (null,'Pago Pago','AS','American Samoa',54343);
 insert into country values (7686850,'Canberra','AU','Australia',22751014);
 insert into country values (null,'West Island','CC','Cocos (Keeling) Islands',596);
 insert into country values (240,'Avarua','CK','Cook Islands',9838);
 insert into country values (null,'Flying Fish Cove','CX','Christmas Island',1530);
 insert into country values (18270,'Suva','FJ','Fiji',909389);
 insert into country values (702,'Palikir','FM','Micronesia, Federated States of',105216);
 insert into country values (549,'Hagatna (Agana)','GU','Guam',161785);
 insert into country values (811,'Tarawa','KI','Kiribati',105711);
 insert into country values (181.3,'Majuro','MH','Marshall Islands',72191);
 insert into country values (19060,'Noumea','NC','New Caledonia',271615);
 insert into country values (null,'Kingston','NF','Norfolk Island',2210);
 insert into country values (21,'Yaren District','NR','Nauru',9540);
 insert into country values (260,'Alofi','NU','Niue',1190);
 insert into country values (268680,'Wellington','NZ','New Zealand',4438393);
 insert into country values (null,'Papeete','PF','French Polynesia',282703);
 insert into country values (462840,'Port Moresby','PG','Papua New Guinea',6672429);
 insert into country values (null,'Adamstown','PN','Pitcairn',48);
 insert into country values (458,'Melekeok','PW','Palau',21265);
 insert into country values (28450,'Honiara','SB','Solomon Islands',622469);
 insert into country values (null,null,'TK','Tokelau',1337);
 insert into country values (26,'Funafuti','TV','Tuvalu',10869);
 insert into country values (12200,'Port-Vila','VU','Vanuatu',272264);
 insert into country values (null,'Mata-Utu','WF','Wallis and Futuna',15500);
 insert into country values (2944,'Apia','WS','Samoa (Western)',197773);
 commit;


=cut

sub aoh2sql {
    my($aoh,$conf)=@_;
    my %def=( #defaults
	name=>'my_table',
	number=>'numeric',
	varchar=>'varchar',
	date=>'date',
	varchar_maxlen=>4000,
	create=>1,
	drop=>0,  # 1 drop table if exists, 2 plain drop
	end=>"commit;\n",
	begin=>"begin;\n",
	fix_colnames=>0,
	);
    my %conf=(%def,(@_<2?():%$conf));
#    $conf{$_}||=$def{$_} for keys%def;
    my %col;
    map $col{$_}++, keys %$_ for @$aoh;
    my @col=sort keys %col;
    my @colerr=grep!/^[a-z]\w+$/i,@col;
    croak "Invalid column name(s): @colerr" if @colerr and !$conf{fix_colnames};
    my(%t,%tdb);
    for my $c (@col){
	my($l,$s,$p,$nn,%ant,$t)=(0,0,0,0);
	for my $r (@$aoh){
	    my $v=$$r{$c};
	    next if !defined$v or $v!~/\S/;
	    $nn++;
	    $l=length($v) if length($v)>$l;
	    no warnings 'uninitialized';
	    if($v=~/^(18|19|20)\d\d(0[1-9]|1[0-2])(0[1-9]|1\d|2\d|3[01])-?\d\d:?\d\d:?\d\d$/ and $conf{date}){
		$ant{date}++;
		next;
	    }



( run in 0.632 second using v1.01-cache-2.11-cpan-71847e10f99 )