view release on metacpan or  search on metacpan

t/02_general.t  view on Meta::CPAN

ok( between(7, 1,10)           ,'between a');
ok( between(undef, 1,10) eq '' ,'between b');
ok( between(7, 10,1)           ,'between c');
ok( between(5,5,5)             ,'between d');

#--btw, a better(?) between
ok( btw(7, 1,10)           ,'btw a');
ok( btw(undef, 1,10) eq '' ,'btw b');
ok( btw(7, 10,1)           ,'btw c');
ok( btw(5,5,5)             ,'btw d');
ok( btw(1,1,10)            ,'btw e'); # numeric order since all three looks like number according to =~$Re_isnum
ok( btw(1,'02',13)         ,'btw f'); # leading zero in '02' leads to alphabetical order
ok( btw(10, 012,10)        ,'btw h'); # leading zero here means oct number, 012 = 10 (8*1+2), so 10 is btw 10 and 10
ok(!btw('003', '02', '09') ,'btw i'); #
ok(!btw('a', 'b', 'c')     ,'btw j'); #
ok( btw('a', 'B', 'c')     ,'btw k'); #
ok( btw('a', 'c', 'B')     ,'btw l'); #
ok( btw( -1, -2, 1)        ,'btw m');
ok( btw( -1, -2, 0)        ,'btw n');
ok( btw( -1, -2, '0e0')    ,'btw o');
#my($btw,$btw2)=(0,0);
#my @errs=grep{my@a=map rand(),1..3;$btw++ if btw(@a);$btw2++ if btw2(@a);btw(@a)!=btw2(@a)}1..1000;
#ok( !@errs, "btw2==btw, btw=$btw btw2=$btw2" );
#use Benchmark qw(:all) ;
#cmpthese(1e5, { btw => sub { btw(rand(),rand(),rand()) },
#                btw2=> sub { btw2(rand(),rand(),rand()) } }); exit;

#--curb
my $vb = 234;
ok( curb( $vb, 200, 250 ) == 234,             'curb 1');
ok( curb( $vb, 150, 200 ) == 200,             'curb 2');
ok( curb( $vb, 250, 300 ) == 250 && $vb==234, 'curb 3');
ok( curb(\$vb, 250, 300 ) == 250 && $vb==250, 'curb 4');
ok( do{eval{curb()};          $@=~/^curb/},   'curb 5'); eval{1};
ok( do{eval{curb(1,2,undef)}; $@=~/^curb/},   'curb 6'); eval{1};
ok( do{eval{curb(1,2,3,4)};   $@=~/^curb/},   'curb 7'); eval{1};

#--distinct
ok( join(", ", distinct(4,9,30,4,"abc",30,"abc")) eq '30, 4, 9, abc' );

#--in, in_num
ok( in(  5,   1,2,3,4,6)         == 0 );
ok( in(  4,   1,2,3,4,6)         == 1 );
ok( in( 'a',  'A','B','C','aa')  == 0 );
ok( in( 'a',  'A','B','C','a')   == 1 );
ok( in( undef,'A','B','C','a')   == 0 );
ok( in( undef,'A','B','C',undef) == 1 );        # undef eq undef
ok( in(5000,  '5e3')      == 0 );
ok( in_num(5000, 1..4999,'5e3')   == 1 );

#--uniq
my @t=(7,2,3,3,4,2,1,4,5,3,"x","xx","x",02,"07");
ok( join( " ", uniq @t ) eq '7 2 3 4 1 5 x xx 07' );

#--union
ok( join( ",", union([1,2,3],[2,3,3,4,4]) ) eq '1,2,3,4' );

#--minus
ok( join( " ", minus( ["five", "FIVE", 1, 2, 3.0, 4], [4, 3, "FIVE"] ) ) eq 'five 1 2' );

#--intersect
ok( join(" ", intersect( ["five", 1, 2, 3.0, 4], [4, 2+1, "five"] )) eq '4 3 five' );

#--not_intersect
ok( join( " ", not_intersect( ["five", 1, 2, 3.0, 4], [4, 2+1, "five"] )) eq '1 2' );

#--subhash
my %pop = ( Norway=>4800000, Sweeden=>8900000, Finland=>5000000,
            Denmark=>5100000, Iceland=>260000, India => 1e9 );
ok_ref({subhash(\%pop,qw/Norway Sweeden Denmark/)},
       {Denmark=>5100000,Norway=>4800000,Sweeden=>8900000}, 'subhash');

#--hashtrans
my%h = ( 1 => {a=>33,b=>55},
         2 => {a=>11,b=>22},
         3 => {a=>88,b=>99} );
ok_ref( {hashtrans(\%h)},
        {a=>{1=>33,2=>11,3=>88},
         b=>{1=>55,2=>22,3=>99}}, 'hashtrans' );

#--ipaddr, ipnum
my $ipnum=ipnum('www.vg.no'); # !defined implies no network
my $ipaddr=defined$ipnum?ipaddr($ipnum):undef;
if( defined $ipaddr ){
  ok( $ipnum=~/^(\d+\.\d+\.\d+\.\d+)$/, 'ipnum'); #hm ip6
  is( ipaddr($ipnum), 'www.vg.no' );
  is( $Acme::Tools::IPADDR_memo{$ipnum}, 'www.vg.no' );
  is( $Acme::Tools::IPNUM_memo{'www.vg.no'}, $ipnum );
}
else{
  ok( 1, 'skip: no network') for 1..4
}

#--in_iprange

eval{in_iprange('x','255.255.255.255')};                  ok( $@=~/malformed ipnum x/,            'in_iprange, malformed ipnum' );
eval{in_iprange('255.255.255.255','x')};                  ok( $@=~/malformed iprange x/,          'in_iprange, malformed iprange' );
eval{in_iprange('0.0.0.0','255.255.255.256')};            ok( $@=~/iprange part should be 0-255/, 'in_iprange, iprange part should be 0-255' );
eval{in_iprange('255.255.256.255','255.255.255.255')};    ok( $@=~/invalid ipnum/,                'in_iprange, invalid ipnum' );
eval{in_iprange('255.255.255.255','255.255.255.255/33')}; ok( $@=~/iprange mask should be 0-32/,  'in_iprange, invalid iprange' );
eval{in_iprange('100.255.255.255','100.255.255.0/22')};   ok( $@=~m|need zero in last 10 bits, should be 100.255.252.0/22|, 'in_iprange, need zero in last 10...' );
ok( in_iprange('255.255.255.255','255.255.255.0/24'), 'in_iprange' );
ok( in_iprange('255.255.255.254','255.255.254.0/23'), 'in_iprange' );
ok( in_iprange('100.255.255.255','100.255.254.0/23'), 'in_iprange, yes' );
ok( in_iprange('100.255.254.0','100.255.254.0/23'),   'in_iprange, y' );
ok( in_iprange('100.255.255.0','100.255.254.0/23'),   'in_iprange, y' );
ok(!in_iprange('100.255.0.1','100.254.254.0/23'),     'in_iprange, n' );
ok( in_iprange('100.255.0.1','100.255.0.1'),          'in_iprange, same' );
ok( in_iprange('100.255.0.1','100.255.0.1/32'),       'in_iprange, same/32' );
ok( in_iprange('0.0.0.1','0.0.0.0/1'),                'in_iprange, /1' );
ok( in_iprange(join('.',map int(rand(256)),1..4),'0.0.0.0/0'), 'in_iprange, /0' );

#--webparams, urlenc, urldec
my $s=join"",map random([qw/hip hop and you dont stop/]), 1..1000;
my %in=("\n&pi=3.14+0\n\n"=>gz($s x 5),123=>123321);
my %out=webparams(join("&",map{urlenc($_)."=".urlenc($in{$_})}sort keys%in));
ok_ref( \%in, \%out, 'webparams 1' );
ok_ref( $a={webparams("b=123&a=1&b=122&a=3&a=2%20")},{a=>'1,3,2 ',b=>'123,122'}, 'webparams 2' );undef$a;

#--chall
my $tmp=tmp();
if($^O eq 'linux' and -w$tmp){
  my $f1="$tmp/tmpf1";
  my $f2="$tmp/tmpf2";
  chmod(0777,$f1,$f2) and unlink($f1, $f2);