qxp.pm by white dragon

qxp.pm

package qxp;
use strict;

# https://code.google.com/p/qxp/

sub H($){pack'H*',$_[0]}
sub by{map{[splice@_,1,$_[0]]}!($#_%$_[0])..$#_/$_[0]}
sub is($){$_ eq$_[0]}
sub cat{join'',@_}
sub list{@_}
sub wa{wantarray?@_:cat@_}
sub yuki(&@){shift->();@_}
sub fopen(;$){open my$z,$_[0]||$_;$z}{my %file;
sub file($){readline($file{$_[0]}||=fopen$_[0])}}
sub slurp(;$){wa map{yuki{close$_}<$_>}fopen$_[0]}
#sub spew($;$){sub{map{print $_ $_[1];close$_}fopen$_[0]}->($_[0],$#_?$_[1]:$_)}
sub spew($;$){open my$z,">$_[0]";print $z $#_?$_[1]:$_;close $z}
sub table{map{chomp;[split/\t/]}@_}
sub trim{map{s/^\s+|\s+$//g}@_?@_:$_}
sub count{my%z;$z{$_}++for@_;\%z}
sub uniq{keys%{count@_}}
sub copy{wa local@_=@_}
sub find(&@){no strict 'refs';local(*{(caller).'::a'})=\(my$a=$_[1]);&{$_[0]}||($a=$_)for(@_[2..$#_]);$a}
sub first(&@){$_[0]->()&&return$_ for@_[1..$#_]}
sub min{find{$a<$_}@_}
sub max{find{$a>$_}@_}
sub section{map{$_->[$_[0]]}@_[1..$#_]}
*#=sub{map$#$_,@_};
sub zip{map section($_,@_),0..max &#(@_)}
sub char{substr$#_?shift:$_,$_[0],1}
sub via(&$){local $_=$_[1];$_[0]->()}

*\=sub{map[section($_,@_)],0..max &#(@_)};

{my%ops;*?=sub{ref$_[-1]?map&?($_[0],@$_),&\(@_[1..$#_]):wa do{my@z=$_[1];@z=$ops{$_[0]}->($_,@z)for@_[2..$#_];@z}};
{no strict 'refs';(*$_,$ops{$_})=eval"sub{&?('$_',\@_)},sub{wa(\@_[1..\$#_]) $_ \$_[0]}" for qw'** =~ !~ * / % x + - . << >> < > <= >= lt gt le ge == != <=> eq ne cmp & | ^ && || .. ... = , => and or xor'}}
#my%refs=(''=>'_',map{$_=>lc substr $_,0,1}qw{SCALAR ARRAY HASH CODE REF GLOB LVALUE});
#sub refs{wa map{$refs{ref $_}||'o'}@_}
#sub _{cat map{
#  is '' ? $_:
#  is 'a' ? @{$_[0]}:
#  ()
#}refs@_}

sub wday{(int(365.25*($_[2]-($_[1]<3)))+int(30.6*(1+$_[1]+12*($_[1]<3)))+$_[0]-621050)%7+1}
sub leap{$_[0]%4?0:$_[0]%100?1:$_[0]%400?0:1}
sub days{(31,(28+leap $_[1]),(31,30,31,30,31)x2)[$_[0]-1]}
sub cal{by 7,((undef)x(wday(1,@_)-1),1..days @_)}

sub all{@_==grep$_,@_}
sub one{1==grep$_,@_}
sub none{!grep$_,@_}
sub any{!&none}

sub import{no strict 'refs';*{caller(0)."::$_"}=${"$_[0]::"}{$_} for grep !/^(BEGIN|__ANON__|a|import)$/, keys%{"$_[0]::"}}