/usr/share/perl5/Object/InsideOut/Overload.pm is in libobject-insideout-perl 3.87-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 | package Object::InsideOut; {
use strict;
use warnings;
no warnings 'redefine';
sub generate_OVERLOAD :Sub(Private)
{
my ($GBL) = @_;
# Overload specifiers
my %TYPE = (
'STRINGIFY' => q/""/,
'NUMERIFY' => q/0+/,
'BOOLIFY' => q/bool/,
'ARRAYIFY' => q/@{}/,
'HASHIFY' => q/%{}/,
'GLOBIFY' => q/*{}/,
'CODIFY' => q/&{}/,
);
my (%code, $code, %meta);
# Generate overload strings
while (my $info = shift(@{$$GBL{'sub'}{'ol'}})) {
if ($$info{'ify'} eq 'EQUATE') {
push(@{$code{$$info{'pkg'}}}, "\tq/==/ => sub { (ref(\$_[0]) eq ref(\$_[1])) && (\${\$_[0]} == \${\$_[1]}) },");
} else {
$$info{'name'} ||= sub_name($$info{'code'}, ":$$info{'ify'}", $$info{'loc'});
my $pkg = $$info{'pkg'};
my $name = $$info{'name'};
push(@{$code{$pkg}}, "\tq/$TYPE{$$info{'ify'}}/ => sub { \$_[0]->$name() },");
$meta{$pkg}{$name}{'kind'} = 'overload';
}
}
delete($$GBL{'sub'}{'ol'});
# Generate entire code string
foreach my $pkg (keys(%code)) {
$code .= "package $pkg;\nuse overload (\n" .
join("\n", @{$code{$pkg}}) .
"\n\t'fallback' => 1);\n";
}
# Eval the code string
my @errs;
local $SIG{'__WARN__'} = sub { push(@errs, @_); };
eval $code;
if ($@ || @errs) {
my ($err) = split(/ at /, $@ || join(" | ", @errs));
OIO::Internal->die(
'message' => "Failure creating overloads",
'Error' => $err,
'Code' => $code,
'self' => 1);
}
# Add accumulated metadata
add_meta(\%meta);
no strict 'refs';
foreach my $pkg (keys(%{$$GBL{'tree'}{'td'}})) {
# Bless an object into every class
# This works around an obscure 'overload' bug reported against
# Class::Std (http://rt.cpan.org/Public/Bug/Display.html?id=14048)
bless(\do{ my $scalar; }, $pkg);
# Verify that scalar dereferencing is not overloaded in any class
if (exists(${$pkg.'::'}{'(${}'})) {
(my $file = $pkg . '.pm') =~ s/::/\//g;
OIO::Code->die(
'location' => [ $pkg, $INC{$file} || '', '' ],
'message' => q/Overloading scalar dereferencing '${}' is not allowed/,
'Info' => q/The scalar of an object is its object ID, and can't be redefined/);
}
}
}
} # End of package's lexical scope
# Ensure correct versioning
($Object::InsideOut::VERSION == 3.87)
or die("Version mismatch\n");
# EOF
|