File Coverage

blib/lib/Pod/Pandoc/Modules.pm
Criterion Covered Total %
statement 47 89 52.8
branch 2 28 7.1
condition 2 20 10.0
subroutine 13 17 76.4
pod 2 5 40.0
total 66 159 41.5


line stmt bran cond sub pod time code
1             package Pod::Pandoc::Modules;
2 5     5   16 use strict;
  5         6  
  5         114  
3 5     5   16 use warnings;
  5         10  
  5         90  
4 5     5   66 use 5.010;
  5         11  
5              
6             our $VERSION = '0.30';
7              
8 5     5   16 use File::Path qw(make_path);
  5         5  
  5         223  
9 5     5   30 use File::Find;
  5         8  
  5         190  
10 5     5   17 use File::Spec;
  5         6  
  5         76  
11 5     5   2116 use File::stat;
  5         22758  
  5         18  
12 5     5   248 use File::Basename qw(dirname);
  5         6  
  5         253  
13 5     5   20 use Pandoc::Elements;
  5         6  
  5         902  
14 5     5   18 use Carp qw(croak);
  5         7  
  5         3548  
15              
16             sub new {
17 1   50 1 0 5 bless( ( $_[1] // {} ), $_[0] );
18             }
19              
20             sub add {
21 0     0 0 0 my ( $self, $name, $doc ) = @_;
22              
23             # TODO: don't override .pod with .pm
24 0 0       0 if ( $self->{$name} ) {
25 0         0 return;
26             }
27             else {
28 0         0 $self->{$name} = $doc;
29             }
30             }
31              
32             sub module_link {
33 2     2 0 4 my ( $module, $opt ) = @_;
34 2 100       6 if ( $opt->{wiki} ) {
35 1         2 my $target = $module;
36 1         5 $target =~ s{::}{-}g;
37 1         4 return Link attributes {}, [ Str $module ], [ $target, 'wikilink' ];
38             }
39             else {
40 1         1 my $name = shift;
41 1         1 my $file = $name;
42 1         4 $file =~ s{::}{/}g;
43 1   50     6 $file .= '.' . ( $opt->{ext} // 'html' );
44 1         4 return Link attributes {}, [ Str $name ], [ $file, $name ];
45             }
46             }
47              
48             sub index {
49 2     2 1 5753 my ( $modules, %opt ) = @_;
50              
51             # TODO: extend, document, and test metadata
52 1         5 my %meta = map { $_ => MetaString "" . $opt{$_} }
53 2         4 grep { defined $opt{$_} } qw{title};
  2         6  
54              
55             my @definitions = map {
56 2         16 [
57             [ module_link( $_, \%opt ) ],
58 2         6 [ [ Plain [ Str $modules->{$_}->metavalue('subtitle') ] ] ]
59             ]
60             } sort keys %$modules;
61              
62 2         461 Document \%meta, [ DefinitionList \@definitions ];
63             }
64              
65             sub serialize {
66 0     0 1   my ( $modules, $dir, $opt, @args ) = _parse_arguments(@_);
67              
68             # adjust links
69             # TODO: create copy instead of transforming, so
70             # this can be called multiple times!
71 0           foreach my $doc ( values %$modules ) {
72             $doc->transform(
73             Link => sub {
74              
75             # TODO: use configured prefix instead of hard-coded URL base
76 0     0     my ( $module, $hash ) =
77             $_->url =~ qr{^https://metacpan\.org/pod/([^#]+)(#.*)?$};
78 0 0 0       return unless ( $module and $modules->{$module} );
79              
80             # TODO: check whether hash link target exists
81 0           my $link = module_link( $module, $opt );
82 0 0         if ( defined $hash ) {
83 0           $link->url( $link->url . $hash );
84             }
85 0           return $link;
86             }
87 0           );
88             }
89              
90             # serialize
91 0           foreach my $doc ( values %$modules ) {
92 0           my $file = $doc->metavalue('file');
93 0           my $module = $doc->metavalue('title');
94              
95 0           my $name = $module;
96 0 0         if ( $opt->{wiki} ) {
97 0           $name =~ s{::}{-}g;
98             }
99             else {
100 0           $name =~ s{::}{/}g;
101             }
102 0   0       $name .= '.' . ( $opt->{ext} // 'html' );
103 0           my $target = File::Spec->catfile( $dir, $name );
104              
105 0 0 0       if ( $opt->{update} and -e $target ) {
106 0 0         next if stat($file)->[9] <= stat($target)->[9];
107             }
108              
109 0           make_path( dirname($target) );
110 0           $doc->to_pandoc( -o => $target, @args );
111 0 0         say "$file => $target" unless $opt->{quiet};
112             }
113              
114             # create index file
115 0 0         if ( $opt->{index} ) {
116 0           my $index = $modules->index(%$opt);
117             my $target =
118 0           File::Spec->catfile( $dir, $opt->{index} . '.' . $opt->{ext} );
119 0           $index->to_pandoc( @args, -o => $target );
120 0 0         say $target unless $opt->{quiet};
121             }
122             }
123              
124             sub _parse_arguments {
125 0     0     my $modules = shift;
126              
127 0 0         my $dir = ref $_[0] ? undef : shift;
128 0 0         my %opt = ref $_[0] ? %{ shift() } : ();
  0            
129              
130 0   0       $dir //= $opt{dir} // croak "output directory must be specified!";
      0        
131 0 0         $opt{index} = 'index' unless exists $opt{index};
132              
133 0   0       $opt{ext} //= 'html';
134 0           $opt{ext} =~ s/^\.//;
135 0 0         croak "ext must not be .pm or .pod" if $opt{ext} =~ /^(pod|pm)$/;
136              
137 0           ( $modules, $dir, \%opt, @_ );
138             }
139              
140             1;
141             __END__