FM / perl-base

/snap/gh/640/usr/lib/x86_64-linux-gnu/perl-base/

/snap/gh/640/usr/lib/x86_64-linux-gnu/perl-base

Name	Size	Mode	Actions
auto/	-	0755	rm
Carp/	-	0755	rm
Exporter/	-	0755	rm
File/	-	0755	rm
Getopt/	-	0755	rm
Hash/	-	0755	rm
IO/	-	0755	rm
IPC/	-	0755	rm
List/	-	0755	rm
Scalar/	-	0755	rm
Text/	-	0755	rm
Tie/	-	0755	rm
unicore/	-	0755	rm
warnings/	-	0755	rm
attributes.pm	3069	0644	edit dl rm
AutoLoader.pm	5487	0644	edit dl rm
base.pm	8912	0644	edit dl rm
builtin.pm	210	0644	edit dl rm
bytes.pm	489	0644	edit dl rm
bytes_heavy.pl	758	0644	edit dl rm
Carp.pm	25399	0644	edit dl rm
Config.pm	3278	0644	edit dl rm
Config_git.pl	409	0644	edit dl rm
Config_heavy.pl	58406	0644	edit dl rm
constant.pm	5737	0644	edit dl rm
Cwd.pm	17356	0644	edit dl rm
DynaLoader.pm	11266	0644	edit dl rm
Errno.pm	4913	0644	edit dl rm
Exporter.pm	2336	0644	edit dl rm
Fcntl.pm	2100	0644	edit dl rm
feature.pm	7891	0644	edit dl rm
fields.pm	5008	0644	edit dl rm
FileHandle.pm	2111	0644	edit dl rm
integer.pm	172	0644	edit dl rm
IO.pm	469	0644	edit dl rm
lib.pm	2284	0644	edit dl rm
locale.pm	3451	0644	edit dl rm
overload.pm	4857	0644	edit dl rm
overloading.pm	964	0644	edit dl rm
parent.pm	460	0644	edit dl rm
POSIX.pm	20442	0644	edit dl rm
re.pm	9556	0644	edit dl rm
SelectSaver.pm	344	0644	edit dl rm
Socket.pm	13865	0644	edit dl rm
strict.pm	1606	0644	edit dl rm
Symbol.pm	2205	0644	edit dl rm
utf8.pm	341	0644	edit dl rm
vars.pm	1148	0644	edit dl rm
warnings.pm	30504	0644	edit dl rm
XSLoader.pm	4115	0644	edit dl rm

Edit: /snap/gh/640/usr/lib/x86_64-linux-gnu/perl-base/overload.pm (4857B)

package overload;

use strict;
no strict 'refs';

our $VERSION = '1.37';

our %ops = (
    with_assign         => "+ - * / % ** << >> x .",
    assign              => "+= -= *= /= %= **= <<= >>= x= .=",
    num_comparison      => "< <= >  >= == !=",
    '3way_comparison'   => "<=> cmp",
    str_comparison      => "lt le gt ge eq ne",
    binary              => '& &= | |= ^ ^= &. &.= |. |.= ^. ^.=',
    unary               => "neg ! ~ ~.",
    mutators            => '++ --',
    func                => "atan2 cos sin exp abs log sqrt int",
    conversion          => 'bool "" 0+ qr',
    iterators           => '<>',
    filetest            => "-X",
    dereferencing       => '${} @{} %{} &{} *{}',
    matching            => '~~',
    special             => 'nomethod fallback =',
);

my %ops_seen;
@ops_seen{ map split(/ /), values %ops } = ();

sub nil {}

sub OVERLOAD {
    my $package = shift;
    my %arg = @_;
    my $sub;
    *{$package . "::(("} = \&nil; # Make it findable via fetchmethod.
    for (keys %arg) {
        if ($_ eq 'fallback') {
            for my $sym (*{$package . "::()"}) {
              *$sym = \&nil; # Make it findable via fetchmethod.
              $$sym = $arg{$_};
            }
        } else {
            warnings::warnif("overload arg '$_' is invalid")
                unless exists $ops_seen{$_};
            $sub = $arg{$_};
            if (not ref $sub) {
                $ {$package . "::(" . $_} = $sub;
                $sub = \&nil;
            }
            #print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
            *{$package . "::(" . $_} = \&{ $sub };
        }
    }
}

sub import {
    my $package = caller();
    # *{$package . "::OVERLOAD"} = \&OVERLOAD;
    shift;
    $package->overload::OVERLOAD(@_);
}

sub unimport {
    my $package = caller();
    shift;
    *{$package . "::(("} = \&nil;
    for (@_) {
        warnings::warnif("overload arg '$_' is invalid")
            unless exists $ops_seen{$_};
        delete $ {$package . "::"}{$_ eq 'fallback' ? '()' : "(" .$_};
    }
}

sub Overloaded {
    my $package = shift;
    $package = ref $package if ref $package;
    mycan ($package, '()') || mycan ($package, '((');
}

sub ov_method {
    my $globref = shift;
    return undef unless $globref;
    my $sub = \&{*$globref};
    no overloading;
    return $sub if $sub != \&nil;
    return shift->can($ {*$globref});
}

sub OverloadedStringify {
    my $package = shift;
    $package = ref $package if ref $package;
    #$package->can('(""')
    ov_method mycan($package, '(""'), $package
        or ov_method mycan($package, '(0+'), $package
        or ov_method mycan($package, '(bool'), $package
        or ov_method mycan($package, '(nomethod'), $package;
}

sub Method {
    my $package = shift;
    if (ref $package) {
        no warnings 'experimental::builtin';
        $package = builtin::blessed($package);
        return undef if !defined $package;
    }
    #my $meth = $package->can('(' . shift);
    ov_method mycan($package, '(' . shift), $package;
    #return $meth if $meth ne \&nil;
    #return $ {*{$meth}};
}

sub AddrRef {
    no overloading;
    "$_[0]";
}

*StrVal = *AddrRef;

sub mycan {                   # Real can would leave stubs.
    my ($package, $meth) = @_;

local $@;
    local $!;
    require mro;

my $mro = mro::get_linear_isa($package);
    foreach my $p (@$mro) {
        my $fqmeth = $p . q{::} . $meth;
        return \*{$fqmeth} if defined &{$fqmeth};
    }

return undef;
}

my %constants = (
    'integer'   =>  0x1000, # HINT_NEW_INTEGER
    'float'     =>  0x2000, # HINT_NEW_FLOAT
    'binary'    =>  0x4000, # HINT_NEW_BINARY
    'q'         =>  0x8000, # HINT_NEW_STRING
    'qr'        => 0x10000, # HINT_NEW_RE
);

use warnings::register;
sub constant {
    # Arguments: what, sub
    while (@_) {
        if (@_ == 1) {
            warnings::warnif ("Odd number of arguments for overload::constant");
            last;
        }
        elsif (!exists $constants {$_ [0]}) {
            warnings::warnif ("'$_[0]' is not an overloadable type");
        }
        elsif (!ref $_ [1] || "$_[1]" !~ /(^|=)CODE$0x[0-9a-f]+$$/) {
            # Can't use C<ref $_[1] eq "CODE"> above as code references can be
            # blessed, and C<ref> would return the package the ref is blessed into.
            if (warnings::enabled) {
                $_ [1] = "undef" unless defined $_ [1];
                warnings::warn ("'$_[1]' is not a code reference");
            }
        }
        else {
            $^H{$_[0]} = $_[1];
            $^H |= $constants{$_[0]};
        }
        shift, shift;
    }
}

sub remove_constant {
    # Arguments: what, sub
    while (@_) {
        delete $^H{$_[0]};
        $^H &= ~ $constants{$_[0]};
        shift, shift;
    }
}

__END__

# ex: set ts=8 sts=4 sw=4 et:

cmd: