File Coverage

blib/lib/GraphViz2/Marpa/Utils.pm
Criterion Covered Total %
statement 30 55 54.5
branch n/a
condition n/a
subroutine 10 15 66.6
pod 2 2 100.0
total 42 72 58.3


line stmt bran cond sub pod time code
1             package GraphViz2::Marpa::Utils;
2              
3 1     1   1522 use strict;
  1         2  
  1         22  
4 1     1   3 use warnings;
  1         1  
  1         19  
5 1     1   3 use warnings qw(FATAL utf8); # Fatalize encoding glitches.
  1         1  
  1         35  
6              
7 1     1   539 use Algorithm::Diff;
  1         3595  
  1         34  
8              
9 1     1   473 use Capture::Tiny 'capture';
  1         21747  
  1         55  
10              
11 1     1   5 use File::Spec;
  1         1  
  1         13  
12 1     1   3 use File::Temp;
  1         1  
  1         50  
13              
14 1     1   514 use GraphViz2::Marpa;
  1         3  
  1         8  
15              
16 1     1   30 use Moo;
  1         1  
  1         4  
17              
18 1     1   218 use Path::Tiny;
  1         1  
  1         376  
19              
20             our $VERSION = '2.10';
21              
22             # ------------------------------------------------
23              
24             sub get_files
25             {
26 0     0 1   my($self, $dir_name, $type) = @_;
27              
28 0           return (sort map{s/\.$type//; $_} grep{/\.$type$/} path($dir_name) -> children);
  0            
  0            
  0            
29              
30             } # End of get_files.
31              
32             # ------------------------------------------------
33              
34             sub perform_1_test
35             {
36 0     0 1   my($self, $file_name) = @_;
37              
38             # The EXLOCK option is for BSD-based systems.
39              
40 0           my($temp_dir) = File::Temp -> newdir('temp.XXXX', CLEANUP => 1, EXLOCK => 0, TMPDIR => 1);
41 0           my($temp_dir_name) = $temp_dir -> dirname;
42 0           my($data_dir_name) = 'data';
43 0           my($html_dir_name) = $temp_dir_name;
44 0           my($in_suffix) = 'gv';
45 0           my($out_suffix) = 'gv';
46              
47 0           my(@new_svg, $new_svg);
48 0           my(@old_svg, $old_svg);
49              
50 0           my($in_file) = File::Spec -> catfile($data_dir_name, "$file_name.$in_suffix");
51 0           my($out_file) = File::Spec -> catfile($temp_dir_name, "$file_name.$out_suffix");
52 0     0     my($stdout, $stderr, $exit) = capture{system $^X, '-Ilib', 'scripts/g2m.pl', '-input_file', $in_file, '-output_file', $out_file};
  0            
53              
54             # Unfortunately, we can't die, because for invalid DOT files there cannot be an output file.
55              
56             #die "Error: g2m.pl did not create an output *.gv file\n" if (! -e $out_file);
57              
58 0     0     ($old_svg, $stderr, $exit) = capture{system 'dot', '-Tsvg', $in_file};
  0            
59 0           @old_svg = split(/\n/, $old_svg);
60 0     0     ($new_svg, $stderr, $exit) = capture{system 'dot', '-Tsvg', $out_file};
  0            
61 0           @new_svg = split(/\n/, $new_svg);
62              
63 0           return Algorithm::Diff -> new(\@old_svg, \@new_svg);
64              
65             } # End of perform_1_test.
66              
67             # -----------------------------------------------
68              
69             1;
70              
71             =pod
72              
73             =head1 NAME
74              
75             C - A demo page generator for C
76              
77             =head1 Synopsis
78              
79             See L.
80              
81             =head1 Description
82              
83             L provides a Marpa-based parser for Graphviz C files,
84             and this module helps generate the demo page.
85              
86             This module is really only of interest to the author.
87              
88             =head1 Distributions
89              
90             This module is available as a Unix-style distro (*.tgz).
91              
92             See L
93             for help on unpacking and installing distros.
94              
95             =head1 Installation
96              
97             Install L as you would for any C module:
98              
99             Run:
100              
101             cpanm GraphViz2::Marpa
102              
103             or run:
104              
105             sudo cpan GraphViz2::Marpa
106              
107             or unpack the distro, and then either:
108              
109             perl Build.PL
110             ./Build
111             ./Build test
112             sudo ./Build install
113              
114             or:
115              
116             perl Makefile.PL
117             make (or dmake or nmake)
118             make test
119             make install
120              
121             =head1 Constructor and Initialization
122              
123             =head2 Calling new()
124              
125             C is called as C<< my($obj) = GraphViz2::Marpa::Utils -> new(k1 => v1, k2 => v2, ...) >>.
126              
127             It returns a new object of type C.
128              
129             Key-value pairs accepted in the parameter list:
130              
131             =over 4
132              
133             =item o (None)
134              
135             =back
136              
137             =head1 Methods
138              
139             =head2 get_files($dir_name, $type)
140              
141             Returns a sorted list of files of type (extension) $type from directory $dir_name.
142              
143             =head2 perform_1_test($file_name)
144              
145             Run C on the input file, and run C on it, and run C on the output file, and compare
146             the outputs of the 2 svg files.
147              
148             Used by scripts/test.html.pl and t/test.t.
149              
150             =head1 Machine-Readable Change Log
151              
152             The file Changes was converted into Changelog.ini by L.
153              
154             =head1 Version Numbers
155              
156             Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions.
157              
158             =head1 Repository
159              
160             L
161              
162             =head1 Support
163              
164             Email the author, or log a bug on RT:
165              
166             L.
167              
168             =head1 Author
169              
170             L was written by Ron Savage Iron@savage.net.auE> in 2012.
171              
172             Home page: L.
173              
174             =head1 Copyright
175              
176             Australian copyright (c) 2012, Ron Savage.
177              
178             All Programs of mine are 'OSI Certified Open Source Software';
179             you can redistribute them and/or modify them under the terms of
180             The Perl License, a copy of which is available at:
181             http://dev.perl.org/licenses/
182              
183             =cut