File Coverage

blib/lib/Map/Tube/Utils.pm
Criterion Covered Total %
statement 23 75 30.6
branch 0 16 0.0
condition 0 12 0.0
subroutine 7 15 46.6
pod 0 7 0.0
total 30 125 24.0


line stmt bran cond sub pod time code
1             package Map::Tube::Utils;
2              
3             $Map::Tube::Utils::VERSION = '3.42';
4             $Map::Tube::Utils::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Map::Tube::Utils - Helper package for Map::Tube.
9              
10             =head1 VERSION
11              
12             Version 3.42
13              
14             =cut
15              
16 1     1   25 use 5.006;
  1         4  
17 1     1   7 use strict; use warnings;
  1     1   3  
  1         30  
  1         6  
  1         3  
  1         97  
18 1     1   508 use JSON;
  1         11427  
  1         7  
19 1     1   965 use File::Share ':all';
  1         8517  
  1         193  
20              
21 1     1   12 use vars qw(@ISA @EXPORT_OK);
  1         4  
  1         1141  
22             require Exporter;
23             @ISA = qw(Exporter);
24             @EXPORT_OK = qw(to_perl is_same trim common_lines filter get_method_map is_valid_color);
25              
26             our @COLOR_NAMES = _color_names();
27              
28             =head1 DESCRIPTION
29              
30             B.
31              
32             =cut
33              
34             sub to_perl {
35 0     0 0 0 my ($file) = @_;
36              
37 0         0 my $json_text = do {
38 0 0       0 open(my $json_fh, $file) or die("ERROR: Can't open \$file\": $!\n");
39 0         0 local $/;
40 0         0 my $text = <$json_fh>;
41 0         0 close($json_fh);
42 0         0 $text;
43             };
44              
45 0         0 return JSON->new->allow_nonref->utf8(1)->decode($json_text);
46             }
47              
48             sub trim {
49 0     0 0 0 my ($data) = @_;
50              
51 0 0       0 return unless defined $data;
52              
53 0         0 $data =~ s/\s+/ /g;
54 0         0 $data =~ s/^\s+|\s+$//g;
55              
56 0         0 return $data;
57             }
58              
59             sub is_same {
60 0     0 0 0 my ($this, $that) = @_;
61              
62 0 0 0     0 return 0 unless (defined($this) && defined($that));
63              
64 0 0 0     0 (_is_number($this) && _is_number($that))
65             ?
66             (return ($this == $that))
67             :
68             (uc($this) eq uc($that));
69             }
70              
71             sub common_lines {
72 0     0 0 0 my ($a, $b) = @_;
73              
74 0         0 my %element = map { $_ => undef } @{$a};
  0         0  
  0         0  
75 0         0 return grep { exists($element{$_}) } @{$b};
  0         0  
  0         0  
76             }
77              
78             sub filter {
79 0     0 0 0 my ($data) = @_;
80              
81 0         0 my %c;
82 0         0 for my $i (0 .. $#$data) {
83 0         0 for my $m (@{ $data->[$i] }) {
  0         0  
84 0         0 undef $c{$m}{$i};
85             }
86             }
87              
88 0         0 my @common = sort { $a cmp $b }
89 0         0 grep @$data == keys %{ $c{$_} },
  0         0  
90             keys %c;
91              
92 0 0       0 return [ map [@common], @$data ] if @common;
93              
94 0         0 my %r;
95 0         0 for my $i (0 .. $#$data - 1) {
96 0         0 for my $m (@{ $data->[$i] }) {
  0         0  
97 0 0       0 if (exists $c{$m}{ $i + 1 }) {
98 0         0 undef $r{$_}{$m} for $i, $i + 1;
99             }
100             }
101             }
102              
103             return [
104 0         0 map [ sort { $a cmp $b }
105 0         0 keys %{ $r{$_} } ],
106 0         0 sort { $a cmp $b } keys %r
  0         0  
107             ];
108             }
109              
110             sub get_method_map {
111              
112             return {
113 0     0 0 0 fuzzy_find => {
114             module => 'Map::Tube::Plugin::FuzzyFind',
115             exception => 'Map::Tube::Exception::MissingPluginFuzzyFind',
116             },
117             as_image => {
118             module => 'Map::Tube::Plugin::Graph',
119             exception => 'Map::Tube::Exception::MissingPluginGraph',
120             },
121             to_xml => {
122             module => 'Map::Tube::Plugin::Formatter',
123             exception => 'Map::Tube::Exception::MissingPluginFormatter',
124             },
125             to_json => {
126             module => 'Map::Tube::Plugin::Formatter',
127             exception => 'Map::Tube::Exception::MissingPluginFormatter',
128             },
129             to_yaml => {
130             module => 'Map::Tube::Plugin::Formatter',
131             exception => 'Map::Tube::Exception::MissingPluginFormatter',
132             },
133             to_string => {
134             module => 'Map::Tube::Plugin::Formatter',
135             exception => 'Map::Tube::Exception::MissingPluginFormatter',
136             },
137             };
138             }
139              
140             sub is_valid_color {
141 0     0 0 0 my ($color) = @_;
142              
143 0 0       0 return 0 unless defined $color;
144              
145 0 0 0     0 if (($color =~ /^#[a-f0-9]{6}$/i)
146             ||
147 0         0 (grep { lc($color) eq $_ } @COLOR_NAMES)) {
148 0         0 return 1;
149             }
150             else {
151 0         0 return 0;
152             }
153             }
154              
155             #
156             #
157             # PRIVATE METHODS
158              
159             sub _is_number {
160 0     0   0 my ($this) = @_;
161              
162 0   0     0 return (defined($this)
163             && ($this =~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/));
164             }
165              
166             sub _color_names {
167              
168 1     1   5 my $source = dist_file('Map-Tube', 'color-names.txt');
169 1         331 open (FILE, $source);
170 1         82 my @color_names = ;
171 1         11 chomp @color_names;
172 1         7 close (FILE);
173              
174 1         24 return @color_names;
175             }
176              
177             =head1 AUTHOR
178              
179             Mohammad S Anwar, C<< >>
180              
181             =head1 REPOSITORY
182              
183             L
184              
185             =head1 BUGS
186              
187             Please report any bugs or feature requests to C, or
188             through the web interface at L.
189             I will be notified, and then you'll automatically be notified of progress on your
190             bug as I make changes.
191              
192             =head1 SUPPORT
193              
194             You can find documentation for this module with the perldoc command.
195              
196             perldoc Map::Tube::Utils
197              
198             You can also look for information at:
199              
200             =over 4
201              
202             =item * RT: CPAN's request tracker (report bugs here)
203              
204             L
205              
206             =item * AnnoCPAN: Annotated CPAN documentation
207              
208             L
209              
210             =item * CPAN Ratings
211              
212             L
213              
214             =item * Search CPAN
215              
216             L
217              
218             =back
219              
220             =head1 LICENSE AND COPYRIGHT
221              
222             Copyright (C) 2010 - 2016 Mohammad S Anwar.
223              
224             This program is free software; you can redistribute it and / or modify it under
225             the terms of the the Artistic License (2.0). You may obtain a copy of the full
226             license at:
227              
228             L
229              
230             Any use, modification, and distribution of the Standard or Modified Versions is
231             governed by this Artistic License.By using, modifying or distributing the Package,
232             you accept this license. Do not use, modify, or distribute the Package, if you do
233             not accept this license.
234              
235             If your Modified Version has been derived from a Modified Version made by someone
236             other than you,you are nevertheless required to ensure that your Modified Version
237             complies with the requirements of this license.
238              
239             This license does not grant you the right to use any trademark, service mark,
240             tradename, or logo of the Copyright Holder.
241              
242             This license includes the non-exclusive, worldwide, free-of-charge patent license
243             to make, have made, use, offer to sell, sell, import and otherwise transfer the
244             Package with respect to any patent claims licensable by the Copyright Holder that
245             are necessarily infringed by the Package. If you institute patent litigation
246             (including a cross-claim or counterclaim) against any party alleging that the
247             Package constitutes direct or contributory patent infringement,then this Artistic
248             License to you shall terminate on the date that such litigation is filed.
249              
250             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
251             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
252             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
253             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
254             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
255             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
256             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
257              
258             =cut
259              
260             1; # End of Map::Tube::Utils