view release on metacpan or  search on metacpan

lib/Class/Usul/Functions.pm  view on Meta::CPAN

      or throw( Tainted, [ $string ], level => 3 );

   return $untainted;
}

sub urandom (;$$) {
   my ($wanted, $opts) = @_; $wanted //= 64; $opts //= {};

   my $default = [ q(), 'dev', $OSNAME eq 'freebsd' ? 'random' : 'urandom' ];
   my $io      = io( $opts->{source} // $default )->block_size( $wanted );

   my $red; $io->exists and $io->is_readable and $red = $io->read
      and $red == $wanted and return ${ $io->buffer };

   my $res = q(); while (length $res < $wanted) { $res .= $_pseudo_random->() }

   return substr $res, 0, $wanted;
}

sub uuid (;$) {
   return io( $_[ 0 ] // UUID_PATH )->chomp->getline;
}

sub whiten ($) {
   my $v = unpack "b*", pop; my $pad = " \t" x 8;

   $v =~ tr{01}{ \t}; $v =~ s{ (.{9}) }{$1\n}gmx;

   return "${pad}\n${v}";
}

sub zip (@) {
   my $p = @_ / 2; return @_[ map { $_, $_ + $p } 0 .. $p - 1 ];
}

# Function composition
sub chain (;@) {
   return (fold( sub { my ($x, $y) = @_; $x->$y } )->( shift ))->( @_ );
}

sub compose (&;$) { # Was called build
   my ($f, $g) = @_; $g //= sub { @_ }; return sub { $f->( $g->( @_ ) ) };
}

sub curry (&$;@) {
   my ($f, @args) = @_; return sub { $f->( @args, @_ ) };
}

sub fold (&) {
   my $f = shift;

   return sub (;$) {
      my $x = shift;

      return sub (;@) {
         my $y = $x; $y = $f->( $y, shift ) while (@_); return $y;
      }
   }
}

sub Y (&) {
   my $f = shift; return sub { $f->( Y( $f ) )->( @_ ) };
}

sub factorial ($) {
   return Y( sub (&) {
      my $fac  = shift;

      return sub ($) {
         my $n = shift;

         return $n < 2 ? 1 : $n * $fac->( $n - 1 ) } } )->( @_ );
}

sub fibonacci ($) {
   return Y( sub {
      my $fib  = shift;

      return sub {
         my $n = shift;

         return $n == 0 ? 0
              : $n == 1 ? 1
                        : $fib->( $n - 1 ) + $fib->( $n - 2 ) } } )->( @_ );
}

sub product (;@) {
   return ((fold { $_[ 0 ] * $_[ 1 ] })->( 1 ))->( @_ );
}

sub sum (;@) {
   return ((fold { $_[ 0 ] + $_[ 1 ] })->( 0 ))->( @_ );
}

1;

__END__

=pod

=head1 Name

Class::Usul::Functions - Globally accessible functions

=head1 Synopsis

   package MyBaseClass;

   use Class::Usul::Functions qw( functions to import );

=head1 Description

Provides globally accessible functions

=head1 Subroutines/Methods

=head2 C<abs_path>

   $absolute_untainted_path = abs_path $some_path;

Untaints path. Makes it an absolute path and returns it. Returns undef