once.pl
changeset 56 39c4a5f4ac33
parent 55 1f4bf7fe870e
child 57 4edd34dee93d
equal deleted inserted replaced
55:1f4bf7fe870e 56:39c4a5f4ac33
    48 sub deslash;      # cleanup a path name
    48 sub deslash;      # cleanup a path name
    49 sub gen_uuid;     # create a uniq identifier
    49 sub gen_uuid;     # create a uniq identifier
    50 sub base62;
    50 sub base62;
    51 sub md5_base62 { ... }
    51 sub md5_base62 { ... }
    52 
    52 
    53 my $rxVIEW = qr/[a-z\d]{6}-[a-z\d]+/i; # date-userhash
    53 my $rxVIEW = qr/[a-z\d]{6}-[a-z\d]+/i;      # date-userhash
    54 my $rxFILE = qr/[a-z\d]{6}-[a-z\d]+-./i; # date-filehash-deletemode
    54 my $rxFILE = qr/[a-z\d]{6}-[a-z\d]+-./i;    # date-filehash-deletemode
    55 
    55 
    56 umask 077;
    56 umask 077;
    57 
    57 
    58 # The working (var) directory gets passed to us via ONCE_VAR environment
    58 # The working (var) directory gets passed to us via ONCE_VAR environment
    59 # FIXME: Should we allow the current directory as an alternative?
    59 # FIXME: Should we allow the current directory as an alternative?
   333       @footer,
   333       @footer,
   334       end_html;
   334       end_html;
   335     exit 0;
   335     exit 0;
   336 }
   336 }
   337 
   337 
       
   338 sub unbase62 {
       
   339     my @digits = reverse split '', shift;
       
   340     state $value = do {
       
   341         my %value;
       
   342         for (
       
   343             my ($symbol, $value) = (base62(0), 0) ;
       
   344             length($symbol) == 1 ;
       
   345             $symbol = base62 ++$value
       
   346           )
       
   347         {
       
   348             $value{$symbol} = $value;
       
   349         }
       
   350         \%value;
       
   351     };
       
   352     state $base = scalar keys %$value;
       
   353 
       
   354     my $unbase62 = 0;
       
   355     while (my ($p, $symbol) = each @digits) {
       
   356         $unbase62 += $value->{$symbol} * $base**$p;
       
   357     }
       
   358     return $unbase62;
       
   359 }
       
   360 
   338 sub base62 {
   361 sub base62 {
   339     my $n = shift // $_;
   362     my $n = shift // $_;
   340     die 'input is >MAXINT' if $n == $n - 1 or $n == $n + 1;
   363     die 'input is >MAXINT' if $n == $n - 1 or $n == $n + 1;
   341     state $digits = [0..9, 'a'..'z', 'A'..'Z'];
   364     state $digits = [0..9, 'a'..'z', 'A'..'Z'];
   342     state $base = @$digits;
   365     state $base = @$digits;