$Map::Tube::Utils::VERSION = '4.09';
$Map::Tube::Utils::AUTHORITY = 'cpan:MANWAR';
our $COLOR_NAMES = _color_names();
our @EXPORT_OK = qw/trim filter to_perl is_same common_lines untaint_path is_tainted get_method_map is_valid_color/;
sub untaint_path {
my ($tainted_path) = @_;
$tainted_path =~ /^([[:print:]]+)$/
or die "Tainted path: non-printable characters detected";
my $clean_path = $1;
my $path = path($clean_path)->realpath;
-f $path or die "Not a regular file: $path";
return "$path";
}
sub is_tainted {
my ($data) = @_;
if (ref $data eq 'HASH') {
my %clean;
for my $key (keys %$data) {
if (Scalar::Util::tainted($key)) {
die "Tainted key: $key\n";
}
is_tainted($data->{$key});
}
}
elsif (ref $data eq 'ARRAY') {
for my $element (@$data) {
is_tainted($element);
}
}
elsif (!ref $data) {
if (Scalar::Util::tainted($data)) {
die "Tainted scalar: $data\n";
}
}
else {
die "Unsupported data type: " . ref($data) . "\n";
}
return 0;
}
sub to_perl {
my ($file) = @_;
$file = untaint_path($file);
my $json_text = do {
open(my $json_fh, "<", $file) or die("ERROR: Can't open $file: $!\n");
local $/;
my $text = <$json_fh>;
close($json_fh);
$text;
};
try {
my $data = JSON::MaybeXS->new->allow_nonref->utf8(1)->decode($json_text);
return $data unless is_tainted($data);
}
catch {
die $@;
};
}
sub trim {
my ($data) = @_;
return unless defined $data;
$data =~ s/\s+/ /g;
$data =~ s/^\s+|\s+$//g;
return $data;
}
sub is_same {
my ($this, $that) = @_;
return 0 unless (defined($this) && defined($that));
(_is_number($this) && _is_number($that))
?
(return ($this == $that))
:
(uc($this) eq uc($that));
}
sub common_lines {
my ($a, $b) = @_;
my %element = map { $_ => undef } @{$a};
return grep { exists($element{$_}) } @{$b};
}
sub filter {
my ($data) = @_;
my %c;
for my $i (0 .. $#$data) {
for my $m (@{ $data->[$i] }) {
undef $c{$m}{$i};
}
}
my @common = sort { $a cmp $b }
grep @$data == keys %{ $c{$_} },
keys %c;
return [ map [@common], @$data ] if @common;
my %r;
for my $i (0 .. $#$data - 1) {
for my $m (@{ $data->[$i] }) {
if (exists $c{$m}{ $i + 1 }) {
undef $r{$_}{$m} for $i, $i + 1;
}
}
}
return [
map [ sort keys %{ $r{$_} } ],
sort { $a <=> $b } keys %r
];
}
sub get_method_map {
return {
fuzzy_find => {
module => 'Map::Tube::Plugin::FuzzyFind',
exception => 'Map::Tube::Exception::MissingPluginFuzzyFind',
},
as_image => {
module => 'Map::Tube::Plugin::Graph',
exception => 'Map::Tube::Exception::MissingPluginGraph',
},
to_xml => {
module => 'Map::Tube::Plugin::Formatter',
exception => 'Map::Tube::Exception::MissingPluginFormatter',
},
to_json => {
module => 'Map::Tube::Plugin::Formatter',
exception => 'Map::Tube::Exception::MissingPluginFormatter',
},
to_yaml => {
module => 'Map::Tube::Plugin::Formatter',
exception => 'Map::Tube::Exception::MissingPluginFormatter',
},
to_string => {
module => 'Map::Tube::Plugin::Formatter',
exception => 'Map::Tube::Exception::MissingPluginFormatter',
},
};
}
sub is_valid_color {
my ($color) = @_;
return 0 unless defined $color;
return $color if ($color =~ /^
my $hexcode = $COLOR_NAMES->{lc($color)};
if (defined $hexcode) {
return $hexcode;
}
else {
return 0;
}
}
sub _is_number {
my ($this) = @_;
return (defined($this)
&& ($this =~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/));
}
sub _color_names {
my $source = dist_file('Map-Tube', 'color-names.txt');
open (my $SOURCE_COLOR, "<", $source)
or die("ERROR: Can't open $source: $!\n");
my $color_names = {};
while (my $line = <$SOURCE_COLOR>) {
chomp $line;
my ($name, $hashcode) = split /\,/,$line,2;
$color_names->{lc($name)} = $hashcode;
}
close ($SOURCE_COLOR);
return $color_names;
}
1;