/usr/share/perl5/XXX.pm is in libxxx-perl 0.31-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 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 | use strict; use warnings;
package XXX;
our $VERSION = '0.31';
use base 'Exporter';
our @EXPORT = qw( WWW XXX YYY ZZZ );
our $DumpModule = 'YAML';
sub import {
my ($package, @args) = @_;
for (my $i = 0; $i < @args; $i++) {
my $arg = $args[$i];
if ($arg eq '-with') {
die "-with requires another argument"
unless $i++ < @args;
$DumpModule = $args[$i];
die "Don't know how to use XXX -with '$DumpModule'"
unless $DumpModule =~ /^(
(?:YAML|JSON)(?:::.*)?|
Data::Dumper|
Data::Dump(?:::Color)?
)$/x;
}
# TODO Deprecation. These options are now undocumented. Next releases:
# warn, then die, then remove.
elsif ($arg =~ /^-dumper$/i) {
$DumpModule = 'Data::Dumper';
}
elsif ($arg =~ /^-yaml$/i) {
$DumpModule = 'YAML';
}
else {
next;
}
last;
}
@_ = ($package);
goto &Exporter::import;
}
sub _xxx_dump {
no strict 'refs';
no warnings;
$DumpModule ||= 'YAML';
my $dump_type =
(substr($DumpModule, 0, 4) eq 'YAML') ? 'yaml' :
(substr($DumpModule, 0, 4) eq 'JSON') ? 'json' :
($DumpModule eq 'Data::Dumper') ? 'dumper' :
($DumpModule eq 'Data::Dump') ? 'dump' :
($DumpModule eq 'Data::Dump::Color') ? 'dumpcolor' :
die 'Invalid dump module in $DumpModule';
if (not defined ${"$DumpModule\::VERSION"}) {
eval "require $DumpModule; 1" or die $@;
}
if ($dump_type eq 'yaml') {
return &{"$DumpModule\::Dump"}(@_) . "...\n";
}
elsif ($dump_type eq 'json') {
return &{"$DumpModule\::encode_json"}(@_);
}
elsif ($dump_type eq 'dumper') {
local $Data::Dumper::Sortkeys = 1;
local $Data::Dumper::Indent = 2;
return Data::Dumper::Dumper(@_);
}
elsif ($dump_type eq 'dump') {
return Data::Dump::dump(@_) . "\n";
}
elsif ($dump_type eq 'dumpcolor') {
return Data::Dump::Color::dump(@_) . "\n";
}
else {
die "XXX had an internal error";
}
}
sub _at_line_number {
my ($file_path, $line_number);
my $caller = 0;
while (++$caller) {
no strict 'refs';
my $skipper = (caller($caller))[0] . "::XXX_skip";
next if defined &$skipper and &$skipper();
($file_path, $line_number) = (caller($caller))[1,2];
last;
}
" at $file_path line $line_number\n";
}
sub WWW {
my $dump = _xxx_dump(@_) . _at_line_number();
if (defined &main::diag and
defined &Test::More::diag and
\&main::diag eq \&Test::More::diag
) {
main::diag($dump);
}
else {
warn($dump);
}
return wantarray ? @_ : $_[0];
}
sub XXX {
die _xxx_dump(@_) . _at_line_number();
}
sub YYY {
my $dump = _xxx_dump(@_) . _at_line_number();
if (defined &main::note and
defined &Test::More::note and
\&main::note eq \&Test::More::note
) {
main::note($dump);
}
else {
print($dump);
}
return wantarray ? @_ : $_[0];
}
sub ZZZ {
require Carp;
Carp::confess(_xxx_dump(@_));
}
1;
|