File Coverage

blib/lib/Map/Tube/Text/Table.pm
Criterion Covered Total %
statement 24 97 24.7
branch 0 18 0.0
condition 0 3 0.0
subroutine 8 14 57.1
pod 5 5 100.0
total 37 137 27.0


line stmt bran cond sub pod time code
1             package Map::Tube::Text::Table;
2              
3 2     2   76724 use strict;
  2         17  
  2         55  
4 2     2   10 use warnings;
  2         4  
  2         54  
5              
6 2     2   899 use Class::Utils qw(set_params);
  2         54398  
  2         37  
7 2     2   144 use Error::Pure qw(err);
  2         4  
  2         75  
8 2     2   854 use Map::Tube::Text::Table::Utils qw(table);
  2         6  
  2         55  
9 2     2   140 use List::MoreUtils qw(any);
  2         4  
  2         20  
10 2     2   1466 use Readonly;
  2         4  
  2         95  
11 2     2   13 use Scalar::Util qw(blessed);
  2         3  
  2         2205  
12              
13             # Constants.
14             Readonly::Scalar our $CONNECTED_TO => q{Connected to};
15             Readonly::Scalar our $ID => q{ID};
16             Readonly::Scalar our $JUNCTIONS => q{Junctions};
17             Readonly::Scalar our $LINE => q{Line};
18             Readonly::Scalar our $LINES => q{Lines};
19             Readonly::Scalar our $STATION => q{Station};
20              
21             our $VERSION = 0.05;
22              
23             # Constructor.
24             sub new {
25 0     0 1   my ($class, @params) = @_;
26              
27             # Create object.
28 0           my $self = bless {}, $class;
29              
30             # Print ids.
31 0           $self->{'print_id'} = 0;
32              
33             # Map::Tube object.
34 0           $self->{'tube'} = undef;
35              
36             # Process params.
37 0           set_params($self, @params);
38              
39             # Check Map::Tube object.
40 0 0         if (! defined $self->{'tube'}) {
41 0           err "Parameter 'tube' is required.";
42             }
43 0 0 0       if (! blessed($self->{'tube'})
44             || ! $self->{'tube'}->does('Map::Tube')) {
45              
46 0           err "Parameter 'tube' must be 'Map::Tube' object.";
47             }
48              
49             # Object.
50 0           return $self;
51             }
52              
53             # Print junctions.
54             sub junctions {
55 0     0 1   my $self = shift;
56              
57             # Get data.
58 0           my @data;
59 0           my @title = ($STATION, $LINE, $CONNECTED_TO);
60 0           my @data_len = map { length $_ } @title;
  0            
61 0           my $nodes_hr = $self->{'tube'}->nodes;
62 0           foreach my $node_name (sort keys %{$nodes_hr}) {
  0            
63 0 0         if (@{$nodes_hr->{$node_name}->line} > 1) {
  0            
64              
65             # Get data.
66 0           my @links = map { $self->{'tube'}->get_node_by_id($_)->name }
67 0           split m/,/ms, $nodes_hr->{$node_name}->link;
68             my $data_ar = [
69             $nodes_hr->{$node_name}->name,
70 0           (join ', ', map { $_->name } @{$nodes_hr->{$node_name}->line}),
  0            
  0            
71             (join ', ', sort @links),
72             ];
73 0           push @data, $data_ar;
74              
75             # Maximum data length.
76 0           foreach my $i (0 .. $#{$data_ar}) {
  0            
77 0 0         if (length $data_ar->[$i] > $data_len[$i]) {
78 0           $data_len[$i] = length $data_ar->[$i];
79             }
80             }
81             }
82             }
83              
84             # Print and return table.
85 0           return table($JUNCTIONS, \@data_len, \@title, \@data);
86             }
87              
88             # Print line.
89             sub line {
90 0     0 1   my ($self, $line) = @_;
91              
92             # Get data.
93 0           my @data;
94 0           my @title = ($STATION, $CONNECTED_TO);
95 0 0         if ($self->{'print_id'}) {
96 0           unshift @title, $ID;
97             }
98 0           my @data_len = map { length $_ } @title;
  0            
99 0           my $nodes_hr = $self->{'tube'}->nodes;
100 0           foreach my $node_name (sort keys %{$nodes_hr}) {
  0            
101 0 0   0     if (any { $_ eq $line } map { $_->name }
  0            
  0            
102 0           @{$nodes_hr->{$node_name}->line}) {
103              
104             # Get data.
105 0           my @links = map { $self->{'tube'}->get_node_by_id($_)->name }
106 0           split m/,/ms, $nodes_hr->{$node_name}->link;
107             my $data_ar = [
108 0           $nodes_hr->{$node_name}->name,
109             (join ', ', sort @links),
110             ];
111 0 0         if ($self->{'print_id'}) {
112 0           unshift @{$data_ar}, $nodes_hr->{$node_name}->id,
  0            
113             }
114 0           push @data, $data_ar;
115              
116             # Maximum data length.
117 0           foreach my $i (0 .. $#{$data_ar}) {
  0            
118 0 0         if (length $data_ar->[$i] > $data_len[$i]) {
119 0           $data_len[$i] = length $data_ar->[$i];
120             }
121             }
122             }
123             }
124              
125             # Print and return table.
126 0           return table($LINE." '$line'", \@data_len, \@title, \@data);
127             }
128              
129             # Get lines.
130             sub lines {
131 0     0 1   my $self = shift;
132 0           my $lines_ar = $self->{'tube'}->get_lines;
133 0           my $length = 0;
134 0           my @data;
135 0           foreach my $line (sort @{$lines_ar}) {
  0            
136 0           push @data, [$line];
137 0 0         if (length $line > $length) {
138 0           $length = length $line;
139             }
140             }
141 0           return table($LINES, [$length], undef, \@data);
142             }
143              
144             # Print all.
145             sub print {
146 0     0 1   my $self = shift;
147 0           my $ret = $self->junctions;
148 0           foreach my $line (@{$self->{'tube'}->get_lines}) {
  0            
149 0           $ret .= $self->line($line->name);
150             }
151 0           return $ret;
152             }
153              
154             1;
155              
156             __END__
157              
158             =encoding utf8
159              
160             =head1 NAME
161              
162             Map::Tube::Text::Table - Table output for Map::Tube.
163              
164             =head1 SYNOPSIS
165              
166             use Map::Tube::Text::Table;
167              
168             my $obj = Map::Tube::Text::Table->new(%params);
169             my $text = $obj->junctions;
170             my $text = $obj->line($line);
171             my $text = $obj->lines;
172             my $text = $obj->print;
173              
174             =head1 METHODS
175              
176             =over 8
177              
178             =item C<new(%params)>
179              
180             Constructor.
181              
182             =over 8
183              
184             =item * C<print_id>
185              
186             Flag, that means printing of ID.
187             Affected methods:
188             - line()
189             - print() (by line()).
190             Default value is 0.
191              
192             =item * C<tube>
193              
194             Map::Tube object.
195             It is required.
196             Default value is undef.
197              
198             =back
199              
200             =item C<junctions()>
201              
202             Print junctions.
203             Returns string with unicode text table.
204              
205             =item C<line($line)>
206              
207             Print line.
208             Returns string with unicode text table.
209              
210             =item C<lines()>
211              
212             Print sorted lines.
213             Returns string with unicode text table.
214              
215             =item C<print()>
216              
217             Print all (junctions + all lines).
218             Returns string with unicode text table.
219              
220             =back
221              
222             =head1 ERRORS
223              
224             new():
225             Parameter 'tube' is required.
226             Parameter 'tube' must be 'Map::Tube' object.
227             From Class::Utils::set_params():
228             Unknown parameter '%s'.
229              
230             =head1 EXAMPLE
231              
232             use strict;
233             use warnings;
234              
235             use Encode qw(encode_utf8);
236             use English;
237             use Error::Pure qw(err);
238             use Map::Tube::Text::Table;
239              
240             # Error::Pure environment.
241             $ENV{'ERROR_PURE'} = 'AllError';
242              
243             # Arguments.
244             if (@ARGV < 1) {
245             print STDERR "Usage: $0 metro\n";
246             exit 1;
247             }
248             my $metro = $ARGV[0];
249            
250             # Object.
251             my $class = 'Map::Tube::'.$metro;
252             eval "require $class;";
253             if ($EVAL_ERROR) {
254             err "Cannot load '$class' class.",
255             'Error', $EVAL_ERROR;
256             }
257            
258             # Metro object.
259             my $tube = eval "$class->new";
260             if ($EVAL_ERROR) {
261             err "Cannot create object for '$class' class.",
262             'Error', $EVAL_ERROR;
263             }
264            
265             # GraphViz object.
266             my $table = Map::Tube::Text::Table->new(
267             'tube' => $tube,
268             );
269            
270             # Print out.
271             print encode_utf8($table->print);
272              
273             # Output without arguments like:
274             # Usage: /tmp/SZXfa2g154 metro
275              
276             # Output with 'Tbilisi' argument like:
277             # ┌──────────────────────────────────────────────────────────────────────────────────────────────────┐
278             # │ Junctions │
279             # ├──────────────────┬──────────────────────────────────────────┬────────────────────────────────────┤
280             # │ Station │ Line │ Connected to │
281             # ├──────────────────┼──────────────────────────────────────────┼────────────────────────────────────┤
282             # │ სადგურის მოედანი │ ახმეტელი-ვარკეთილის ხაზი,საბურთალოს ხაზი │ მარჯანიშვილი, ნაძალადევი, წერეთელი │
283             # └──────────────────┴──────────────────────────────────────────┴────────────────────────────────────┘
284             # ┌───────────────────────────────────────────────────────────┐
285             # │ Line 'ახმეტელი-ვარკეთილის ხაზი' │
286             # ├──────────────────────┬────────────────────────────────────┤
287             # │ Station │ Connected to │
288             # ├──────────────────────┼────────────────────────────────────┤
289             # │ ახმეტელის თეატრი │ სარაჯიშვილი │
290             # │ სარაჯიშვილი │ ახმეტელის თეატრი, გურამიშვილი │
291             # │ გურამიშვილი │ სარაჯიშვილი, ღრმაღელე │
292             # │ ღრმაღელე │ გურამიშვილი, დიდუბე │
293             # │ დიდუბე │ გოცირიძე, ღრმაღელე │
294             # │ გოცირიძე │ დიდუბე, ნაძალადევი │
295             # │ ნაძალადევი │ გოცირიძე, სადგურის მოედანი │
296             # │ მარჯანიშვილი │ რუსთაველი, სადგურის მოედანი │
297             # │ რუსთაველი │ თავისუფლების მოედანი, მარჯანიშვილი │
298             # │ თავისუფლების მოედანი │ ავლაბარი, რუსთაველი │
299             # │ ავლაბარი │ 300 არაგველი, თავისუფლების მოედანი │
300             # │ 300 არაგველი │ ავლაბარი, ისანი │
301             # │ ისანი │ 300 არაგველი, სამგორი │
302             # │ სამგორი │ ვარკეთილი, ისანი │
303             # │ ვარკეთილი │ სამგორი │
304             # │ სადგურის მოედანი │ მარჯანიშვილი, ნაძალადევი, წერეთელი │
305             # └──────────────────────┴────────────────────────────────────┘
306             # ┌────────────────────────────────────────────────────────────────────┐
307             # │ Line 'საბურთალოს ხაზი' │
308             # ├─────────────────────────┬──────────────────────────────────────────┤
309             # │ Station │ Connected to │
310             # ├─────────────────────────┼──────────────────────────────────────────┤
311             # │ წერეთელი │ სადგურის მოედანი, ტექნიკური უნივერსიტეტი │
312             # │ ტექნიკური უნივერსიტეტი │ სამედიცინო უნივერსიტეტი, წერეთელი │
313             # │ სამედიცინო უნივერსიტეტი │ დელისი, ტექნიკური უნივერსიტეტი │
314             # │ დელისი │ ვაჟა-ფშაველა, სამედიცინო უნივერსიტეტი │
315             # │ ვაჟა-ფშაველა │ დელისი │
316             # │ სადგურის მოედანი │ მარჯანიშვილი, ნაძალადევი, წერეთელი │
317             # └─────────────────────────┴──────────────────────────────────────────┘
318              
319             =head1 DEPENDENCIES
320              
321             L<Class::Utils>,
322             L<Error::Pure>,
323             L<Map::Tube::Text::Table::Utils>,
324             L<List::MoreUtils>,
325             L<Readonly>,
326             L<Scalar::Util>.
327              
328             =head1 SEE ALSO
329              
330             =over
331              
332             =item L<Task::Map::Tube>
333              
334             Install the Map::Tube modules.
335              
336             =item L<Task::Map::Tube::Metro>
337              
338             Install the Map::Tube concrete metro modules.
339              
340             =back
341              
342             =head1 REPOSITORY
343              
344             L<https://github.com/michal-josef-spacek/Map-Tube-Text-Table>
345              
346             =head1 AUTHOR
347              
348             Michal Josef Å paček L<mailto:skim@cpan.org>
349              
350             L<http://skim.cz>
351              
352             =head1 LICENSE AND COPYRIGHT
353              
354             © 2014-2020 Michal Josef Å paček
355             Artistic License
356             BSD 2-Clause License
357              
358             =head1 VERSION
359              
360             0.05
361              
362             =cut