view release on metacpan or  search on metacpan

lib/Fauxtobox.pm  view on Meta::CPAN

}

sub _fixed {
    my ($n, $name) = @_;
    _fixed_opt $n, 0, $name
}

sub _scalar {
    my ($name) = @_;
    _fixed 1, $name
}

sub _hxa {
    my ($name) = @_;
    my $body =
        $^V ge v5.12.0 ?
            "ref(\$_[0]) eq 'ARRAY' ? $name \@{\$_[0]} : $name %{\$_[0]}" :
            "$name %{\$_[0]}"
    ;
    $body = "[$body]" unless $name eq 'each';
    $name => eval_string("sub { $body }")
}

my %functions = (
    apply => sub { my $x = shift; my $f = shift; $f->($x, @_) },
    list  => sub { ref($_[0]) eq 'HASH' ? %{$_[0]} : @{$_[0]} },
    qr    => sub { @_ > 1 ? qr/(?$_[1])$_[0]/ : qr/$_[0]/ },

    m    => sub { $_[0] =~ /$_[1]/   },
    m_g  => sub { $_[0] =~ /$_[1]/g  },
    m_gc => sub { $_[0] =~ /$_[1]/gc },

    s    => sub { ref($_[2]) ? $_[0] =~ s/$_[1]/$_[2]()/e  : $_[0] =~ s/$_[1]/$_[2]/  },
    s_g  => sub { ref($_[2]) ? $_[0] =~ s/$_[1]/$_[2]()/ge : $_[0] =~ s/$_[1]/$_[2]/g },
    $^V ge v5.14.0 ? (
        s_r  => eval_string('sub { ref($_[2]) ? $_[0] =~ s/$_[1]/$_[2]()/re  : $_[0] =~ s/$_[1]/$_[2]/r  }'),
        s_gr => eval_string('sub { ref($_[2]) ? $_[0] =~ s/$_[1]/$_[2]()/gre : $_[0] =~ s/$_[1]/$_[2]/gr }'),
    ) : (
        s_r  => sub { my $s = $_[0]; if (ref $_[2]) { $s =~ s/$_[1]/$_[2]()/e  } else { $s =~ s/$_[1]/$_[2]/  } $s },
        s_gr => sub { my $s = $_[0]; if (ref $_[2]) { $s =~ s/$_[1]/$_[2]()/ge } else { $s =~ s/$_[1]/$_[2]/g } $s },
    ),

    (map _filetest($_), qw(
        r w x o
        R W X O
        e z s
        f d l p S b c t
        u g k
        T B
        M A C
    )),

    _scalar('abs'),
    _scalar('alarm'),
    _fixed(2, 'atan2'),
    bless => defined &CORE::bless ? \&CORE::bless : sub { bless $_[0], @_ > 1 ? $_[1] : scalar caller },
    _scalar('chdir'),
    _xlist(1, 'chmod'),
    _xlist(0, 'chomp'),
    _xlist(0, 'chop'),
    _xlist(2, 'chown'),
    _scalar('chr'),
    _scalar('chroot'),
    _scalar('cos'),
    _fixed(2, 'crypt'),
    defined => sub { defined $_[0] },
    delete => sub {
        ref($_[0]) eq 'ARRAY' ?
            delete $_[0][$_[1]] :
            delete $_[0]{$_[1]}
    },
    _scalar('die'),
    _hxa('each'),
    eval => sub { eval $_[0] },
    exec => sub {
        my $prog = shift;
        @_ ? exec { $prog } @_ :
        ref($prog) eq 'ARRAY' ? exec @$prog :
        exec $prog
    },
    exists => sub {
        ref($_[0]) eq 'ARRAY' ?
            exists $_[0][$_[1]] :
            exists $_[0]{$_[1]}
    },
    _scalar('exit'),
    _scalar('exp'),
    $^V ge v5.16.0 ? (fc => \&CORE::fc) : (),
    _scalar('getpgrp'),
    _scalar('getpwnam'),
    _scalar('getgrnam'),
    _scalar('gethostbyname'),
    _scalar('getnetbyname'),
    _scalar('getprotobyname'),
    _scalar('getpwuid'),
    _scalar('getgrgid'),
    _fixed(2, 'getservbyname'),
    _fixed(2, 'gethostbyaddr'),
    _fixed(2, 'getnetbyaddr'),
    _scalar('getprotobynumber'),
    _fixed(2, 'getservbyport'),
    glob => sub { [ glob $_[0] ] },
    _scalar('gmtime'),
    grep => sub { my ($arg, $f) = @_; [ grep $f->($_), @$arg ] },
    _scalar('hex'),
    _fixed_opt(2, 1, 'index'),
    _scalar('int'),
    join => sub { join $_[1], @{$_[0]} },
    _hxa('keys'),
    _xlist(1, 'kill'),
    _scalar('lc'),
    _scalar('lcfirst'),
    _scalar('length'),
    _fixed(2, 'link'),
    _scalar('localtime'),
    _scalar('log'),
    _scalar('lstat'),
    map => sub { my ($arg, $f) = @_; [ map $f->($_), @$arg ] },
    _scalar('mkdir'),
    _scalar('oct'),
    _scalar('ord'),

lib/Fauxtobox.pm  view on Meta::CPAN

=item $_test_C

These are file test operators. C<< $X->$_test_X >> is equivalent to
C<< -X $X >> for all letters I<X> listed above.

See L<perlfunc/-X>.

=item $_abs

C<< $X->$_abs >> is equivalent to C<< abs $X >>.

See L<perlfunc/abs>.

=item $_alarm

C<< $X->$_alarm >> is equivalent to C<< alarm $X >>.

See L<perlfunc/alarm>.

=item $_atan2

C<< $X->atan2($Y) >> is equivalent to C<< atan2 $X, $Y >>.

See L<perlfunc/atan2>.

=item $_bless

C<< $X->$_bless($CLASS) >> is equivalent to C<< bless $X, $CLASS >>.
C<< $X->$_bless >> is equivalent to C<< bless $X >>.

See L<perlfunc/bless>.

=item $_chdir

C<< $X->$_chdir >> is equivalent to C<< chdir $X >>.

See L<perlfunc/chdir>.

=item $_chmod

C<< $X->$_chmod($MODE) >> is equivalent to C<< chmod $MODE, @{$X} >> if
C<$X> is an array reference and C<< chmod $MODE, $X >> otherwise.

See L<perlfunc/chmod>.

=item $_chomp

C<< $X->$_chomp >> is equivalent to C<< chomp @{$X} >> if C<$X> is an array
reference and C<< chomp $X >> otherwise.

See L<perlfunc/chomp>.

=item $_chop

C<< $X->$_chop >> is equivalent to C<< chop @{$X} >> if C<$X> is an array
reference and C<< chop $X >> otherwise.

See L<perlfunc/chop>.

=item $_chown

C<< $X->$_chown($UID, $GID) >> is equivalent to
C<< chown $UID, $GID, @{$X} >> if C<$X> is an array reference and
C<< chown $UID, $GID, $X >> otherwise.

See L<perlfunc/chown>.

=item $_chr

C<< $X->$_chr >> is equivalent to C<< chr $X >>.

See L<perlfunc/chr>.

=item $_chroot

C<< $X->$_chroot >> is equivalent to C<< chroot $X >>.

See L<perlfunc/chroot>.

=item $_cos

C<< $X->$_cos >> is equivalent to C<< cos $X >>.

See L<perlfunc/cos>.

=item $_crypt

C<< $X->$_crypt($SALT) >> is equivalent to C<< crypt $X, $SALT >>.

See L<perlfunc/crypt>.

=item $_defined

C<< $X->$_defined >> is equivalent to C<< defined $X >>.

See L<perlfunc/defined>.

=item $_delete

C<< $X->$_delete($KEY) >> is equivalent to C<< delete $X->[$KEY] >> if $X is
an array reference and C<< delete $X->{$KEY} >> otherwise.

See L<perlfunc/delete>.

=item $_die

C<< $X->$_die >> is equivalent to C<< die $X >>.

See L<perlfunc/die>.

=item $_each

C<< $X->$_each >> is equivalent to C<< each @{$X} >> if C<$X> is an array
reference and C<< each %{$X} >> otherwise.

See L<perlfunc/each>.

=item $_eval

C<< $X->$_eval >> is equivalent to C<< eval $X >>.

See L<perlfunc/eval>.

=item $_exec

C<< $X->$_exec(@ARGS) >> is equivalent to C<< exec { $X } @ARGS >>.