File Coverage

blib/lib/Map/Tube/Text/Table.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


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