diff options
| -rwxr-xr-x | bin/feature-check.pl | 53 |
1 files changed, 52 insertions, 1 deletions
diff --git a/bin/feature-check.pl b/bin/feature-check.pl index 12ae7ed..fca50a9 100755 --- a/bin/feature-check.pl +++ b/bin/feature-check.pl @@ -85,7 +85,7 @@ based on coverage and embedded annotations of its documentation. =item B<--format> -Output format, either of I<table> I<ascii> I<ansi> I<svg> I<graphviz> +Output format, either of I<table> I<ascii> I<ansi> I<svg> I<inkscape> I<graphviz> S<(default value: I<ansi>)> =back @@ -209,12 +209,63 @@ for ( $OPT{format} ) { when ('ansi') { print $graph->as_boxart() } when ('svg') { print $graph->as_svg() } when ('graphviz') { print $graph->as_graphviz() } + when ('inkscape') { + $_ = $graph->as_svg(); + + # define Inkscape namespace, for declaring "connectors" + s{<svg\s[^>]*\K}{ xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"}; + + # collect identifiers for nodes + my %node; + $node{$2} = $1 while m{<g\s+id="(\d+)"\s+class="node">\s*<!--\s*(\S+),\s+rect\s+-->}g; + + # replace concrete arrows with abstract "connectors" + s{ + class="edge">\s* + <!--\s+ + from\s+(?<from>\S+)\s+ + to\s+(?<to>\S+)\s+ + -->(?<space>\s*) + + # drop these + \K + (?: + \s*<!--\s*[^>]*\s*--> + (?: + \s*<line\s[^>]*> + | + \s*<g\s+[^>]*> + \s*<line\s[^>]*> + \s*<line\s[^>]*> + \s*</g> + ) + )+ + \s*<use\s[^>]*> + }{ inkscape_path( \%+, \%node ) }gsxe; + + # keep edges away from nodes + s{<g\s+id="(\d+)"\s+class="node"\K}{ inkscape:connector-avoid="true"}g; + + # fix styling of edges + s/\.edge\s*{\s*font-size:\s*13px;(\s*)stroke:(\s*)black;\K/$1fill:$2none;/; + + print $_; + } default { $log->fatal("unsupported format:$_") && exit 1 } } $log->error($_) for $graph->errors(); $log->warn($_) for $graph->warnings(); +sub inkscape_path { + my ( $mref, $nref ) = @_; + return join $mref->{space}, + "<path d=\"\" inkscape:connector-type=\"polyline\"", + " inkscape:connector-curvature=\"0\"", + " inkscape:connection-start=\"#$nref->{$mref->{from}}\"", + " inkscape:connection-end=\"#$nref->{$mref->{to}}\" />" +} + sub feature { my ($path, $state) = @_; my ( $feature, $docs, $maturity ); |