| Server IP : 23.254.227.96 / Your IP : 216.73.216.183 Web Server : Apache/2.4.62 (Unix) OpenSSL/1.1.1k System : Linux hwsrv-1277026.hostwindsdns.com 4.18.0-477.13.1.el8_8.x86_64 #1 SMP Tue May 30 14:53:41 EDT 2023 x86_64 User : viralblo ( 1001) PHP Version : 8.1.31 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : ON Directory : /proc/self/root/usr/share/doc/perl-Sub-Exporter/t/lib/Test/SubExporter/ |
Upload File : |
#!/usr/bin/perl
package Test::SubExporter::ObjGen::Obj;
use strict;
use warnings;
sub new {
my $class = shift;
my $code = $class->can(shift);
bless { code => $code } => $class;
}
sub group {
return {
foo => sub { return 'FOO' },
bar => sub { return 'BAR' },
};
}
sub baz {
return sub {
return 'BAZ';
};
}
use overload
'&{}' => sub { $_[0]->{code} },
'bool' => sub { 1 };
package Test::SubExporter::ObjGen;
my ($group_o, $group_b, $baz, $quux);
BEGIN {
$quux = sub { sub { 'QUUX' } };
bless $quux => 'Test::SubExporter::Whatever';
$group_o = sub { return {
ringo => sub { 'starr' },
richard => sub { 'starkey' },
} };
bless $group_o => 'Test::SubExporter::Whatever';
$baz = Test::SubExporter::ObjGen::Obj->new('baz');
$group_b = Test::SubExporter::ObjGen::Obj->new('group');
}
use Sub::Exporter -setup => {
exports => { baz => $baz, quux => $quux },
groups => { meta => $group_b, ringo => $group_o },
};
"call me";