File Coverage

blib/lib/Dist/Zilla/Plugin/MapMetro/MakeGraphViz.pm
Criterion Covered Total %
statement 27 29 93.1
branch n/a
condition n/a
subroutine 10 10 100.0
pod n/a
total 37 39 94.8


line stmt bran cond sub pod time code
1             package Dist::Zilla::Plugin::MapMetro::MakeGraphViz;
2              
3 1     1   20498 use strict;
  1         1  
  1         24  
4 1     1   5 use warnings;
  1         2  
  1         23  
5 1     1   12 use 5.14.0;
  1         3  
6              
7             our $VERSION = '0.1103'; # VERSION
8             # ABSTRACT: Automatically creates a GraphViz2 visualisation of a Metro::Map map
9              
10 1     1   854 use Moose;
  1         494617  
  1         6  
11 1     1   8122 use namespace::autoclean;
  1         8399  
  1         5  
12 1     1   1229 use Path::Tiny;
  1         9211  
  1         58  
13 1     1   1011 use MooseX::AttributeShortcuts;
  1         446119  
  1         5  
14 1     1   41898 use Types::Standard qw/HashRef ArrayRef Str Maybe/;
  1         65328  
  1         14  
15 1     1   1791 use Map::Metro::Shim;
  1         3270059  
  1         72  
16 1     1   553 use GraphViz2;
  0            
  0            
17              
18             with 'Dist::Zilla::Role::AfterBuild';
19              
20             has cityname => (
21             is => 'rw',
22             isa => Maybe[Str],
23             predicate => 1,
24             );
25              
26             has settings => (
27             is => 'rw',
28             isa => HashRef,
29             traits => ['Hash'],
30             init_arg => undef,
31             default => sub { { } },
32             handles => {
33             set_setting => 'set',
34             get_setting => 'get',
35             },
36             );
37             has hidden_positions => (
38             is => 'rw',
39             isa => ArrayRef,
40             traits => ['Array'],
41             init_arg => undef,
42             default => sub { [] },
43             handles => {
44             add_hidden => 'push',
45             all_hiddens => 'elements',
46             },
47             );
48              
49              
50             sub after_build {
51             my $self = shift;
52              
53             if(!$ENV{'MMVIZ'} && !$ENV{'MMVIZDEBUG'}) {
54             $self->log('Set either MMVIZ or MMVIZDEBUG to a true value to run this.');
55             return;
56             }
57              
58             my @mapfiles = path('share')->children(qr{map-.*\.metro});
59             return if !scalar @mapfiles;
60              
61             $self->log('Graphvizing...');
62              
63             my $mapfile = shift @mapfiles;
64             $mapfile =~ m{map-(.*)\.metro};
65             my $map = $1;
66             my $graph = Map::Metro::Shim->new(filepath => $mapfile)->parse;
67              
68             my $customconnections = {};
69             if(path('share/graphviz.conf')->exists) {
70             my $settings = path('share/graphviz.conf')->slurp;
71             $settings =~ s{^#.*$}{}g;
72             $settings =~ s{\n}{ }g;
73              
74             foreach my $custom (split m/ +/ => $settings) {
75             if($custom =~ m{^(\d+)-(\d+):([\d\.]+)$}) {
76             my $origin_station_id = $1;
77             my $destination_station_id = $2;
78             my $len = $3;
79              
80             $self->set_setting(sprintf ('len-%s-%s', $origin_station_id, $destination_station_id), $len);
81             $self->set_setting(sprintf ('len-%s-%s', $destination_station_id, $origin_station_id), $len);
82             }
83             elsif($custom =~ m{^\*(\d+):(-?[\d\.]+,-?[\d\.]+)}) {
84             my $station_id = $1;
85             my $hidden_station_pos = $2;
86              
87             $self->add_hidden({ station_id => $station_id, pos => $hidden_station_pos });
88             }
89             elsif($custom =~ m{^(\d+):(-?\d+,-?\d+!?)$}) {
90             my $station_id = $1;
91             my $pos = $2;
92              
93             $self->set_setting(sprintf ('pos-%s', $station_id) => $pos);
94             }
95             elsif($custom =~ m{^!(\d+)-(\d+):(\d+)\^([\d\.]+)$}) {
96             my $origin_station_id = $1;
97             my $destination_station_id = $2;
98             my $connections = $3;
99             my $len = $4;
100              
101             $customconnections->{ $origin_station_id }{ $destination_station_id } = { connections => $connections, len => $len };
102             }
103             }
104             }
105              
106             my $viz = GraphViz2->new(
107             global => { directed => 0 },
108             graph => { epsilon => 0.00001, fontname => 'sans-serif', fontsize => 100, label => $self->has_cityname ? $self->cityname : ucfirst $map, labelloc => 'top' },
109             node => { shape => 'circle', fixedsize => 'true', width => 0.8, height => 0.8, penwidth => 3, fontname => 'sans-serif', fontsize => 20 },
110             edge => { penwidth => 5, len => 1.2 },
111             );
112             foreach my $station ($graph->all_stations) {
113             my %pos = $self->get_pos_for($station->id);
114             my %node = (name => $station->id, label => $station->id, %pos);
115             $viz->add_node(%node);
116             }
117              
118             foreach my $transfer ($graph->all_transfers) {
119             my %len = $self->get_len_for($transfer->origin_station->id, $transfer->destination_station->id);
120             $viz->add_edge(from => $transfer->origin_station->id, to => $transfer->destination_station->id, color => '#888888', style => 'dashed', %len);
121             }
122             foreach my $segment ($graph->all_segments) {
123             foreach my $line_id ($segment->all_line_ids) {
124             my $color = $graph->get_line_by_id($line_id)->color;
125             my $width = $graph->get_line_by_id($line_id)->width;
126             my %len = $self->get_len_for($segment->origin_station->id, $segment->destination_station->id);
127              
128             $viz->add_edge(from => $segment->origin_station->id,
129             to => $segment->destination_station->id,
130             color => $color,
131             penwidth => $width,
132             %len,
133             );
134             }
135             }
136             #* Custom connections (for better visuals)
137             my $invisible_station_id = 99000000;
138             foreach my $hidden ($self->all_hiddens) {
139             $viz->add_node(name => ++$invisible_station_id,
140             label => '',
141             ($ENV{'MMVIZDEBUG'} ? () : (style => 'invis')),
142             width => 0.1,
143             height => 0.1,
144             penwidth => 5,
145             color => '#ff0000',
146             pos => "$hidden->{'pos'}!",
147             );
148             $viz->add_edge(from => $invisible_station_id,
149             to => $hidden->{'station_id'},
150             color => $ENV{'MMVIZDEBUG'} ? '#ff0000' : '#ffffff',
151             penwidth => 5,
152             len => 1,
153             weight => 100,
154             );
155             }
156              
157              
158             foreach my $origin_station_id (keys %{ $customconnections }) {
159             foreach my $destination_station_id (keys %{ $customconnections->{ $origin_station_id }}) {
160             my $len = $customconnections->{ $origin_station_id }{ $destination_station_id }{'len'};
161             my $connection_count = $customconnections->{ $origin_station_id }{ $destination_station_id }{'connections'};
162              
163             my $previous_station_id = $origin_station_id;
164              
165             foreach my $extra_connection (1 .. $connection_count - 1) {
166             $viz->add_node(name => ++$invisible_station_id, label => '', style => 'invis', width => 0.1, height => 0.1, penwidth => 5, color => '#ff0000');
167              
168             $viz->add_edge(from => $previous_station_id,
169             to => $invisible_station_id,
170             color => '#ff0000',
171             penwidth => $ENV{'MMVIZDEBUG'} ? 1 : 0,
172             len => $len,
173             );
174              
175             $previous_station_id = $invisible_station_id;
176             }
177              
178             $viz->add_edge(from => $previous_station_id,
179             to => $destination_station_id,
180             color => '#ff0000',
181             penwidth => $ENV{'MMVIZDEBUG'} ? 1 : 0,
182             len => $len,
183             );
184             }
185             }
186              
187             path('static/images')->mkpath;
188             my $file = sprintf('static/images/%s.png', lc $map);
189             $viz->run(format => 'png', output_file => $file, driver => 'neato');
190              
191             $self->log(sprintf 'Saved in %s.', $file);
192             }
193              
194             sub get_len_for {
195             my $self = shift;
196             my ($origin_station_id, $destination_station_id) = @_;
197             return (len => $self->get_setting("len-$origin_station_id-$destination_station_id")) if $self->get_setting("len-$origin_station_id-$destination_station_id");
198             return (len => $self->get_setting("len-$origin_station_id-0")) if $self->get_setting("len-$origin_station_id-0");
199             return (len => $self->get_setting("len-0-$destination_station_id")) if $self->get_setting("len-0-$destination_station_id");
200             return ();
201             }
202              
203             sub get_pos_for {
204             my $self = shift;
205             my $station_id = shift;
206             return (pos => $self->get_setting("pos-$station_id")) if $self->get_setting("pos-$station_id");
207             return ();
208             }
209              
210             1;
211              
212             __END__
213              
214             =pod
215              
216             =encoding utf-8
217              
218             =head1 NAME
219              
220             Dist::Zilla::Plugin::MapMetro::MakeGraphViz - Automatically creates a GraphViz2 visualisation of a Metro::Map map
221              
222              
223              
224             =begin HTML
225              
226             <p><img src="https://img.shields.io/badge/perl-5.14-brightgreen.svg" alt="Requires Perl 5.14" /> <a href="https://travis-ci.org/Csson/p5-Dist-Zilla-Plugin-mapMetro-MakeGraphViz"><img src="https://api.travis-ci.org/Csson/p5-Dist-Zilla-Plugin-mapMetro-MakeGraphViz.svg?branch=master" alt="Travis status" /></a></p>
227              
228             =end HTML
229              
230              
231             =begin markdown
232              
233             ![Requires Perl 5.14](https://img.shields.io/badge/perl-5.14-brightgreen.svg) [![Travis status](https://api.travis-ci.org/Csson/p5-Dist-Zilla-Plugin-mapMetro-MakeGraphViz.svg?branch=master)](https://travis-ci.org/Csson/p5-Dist-Zilla-Plugin-mapMetro-MakeGraphViz)
234              
235             =end markdown
236              
237             =head1 VERSION
238              
239             Version 0.1103, released 2015-11-02.
240              
241             =head1 SYNOPSIS
242              
243             ;in dist.ini
244             [MapMetro::MakeGraphViz]
245              
246             =head1 DESCRIPTION
247              
248             This L<Dist::Zilla> plugin creates a L<GraphViz2> visualisation of a L<Map::Metro> map, and is only useful in such a distribution.
249              
250             =head1 SEE ALSO
251              
252             =over 4
253              
254             =item *
255              
256             L<Task::MapMetro::Dev> - Map::Metro development tools
257              
258             =item *
259              
260             L<Map::Metro>
261              
262             =item *
263              
264             L<Map::Metro::Plugin::Map>
265              
266             =item *
267              
268             L<Map::Metro::Plugin::Map::Stockholm> - An example
269              
270             =back
271              
272             =head1 SOURCE
273              
274             L<https://github.com/Csson/p5-Dist-Zilla-Plugin-mapMetro-MakeGraphViz>
275              
276             =head1 HOMEPAGE
277              
278             L<https://metacpan.org/release/Dist-Zilla-Plugin-MapMetro-MakeGraphViz>
279              
280             =head1 AUTHOR
281              
282             Erik Carlsson <info@code301.com>
283              
284             =head1 COPYRIGHT AND LICENSE
285              
286             This software is copyright (c) 2015 by Erik Carlsson.
287              
288             This is free software; you can redistribute it and/or modify it under
289             the same terms as the Perl 5 programming language system itself.
290              
291             =cut