File Coverage

blib/lib/Pod/Pandoc/Modules.pm
Criterion Covered Total %
statement 50 89 56.1
branch 7 32 21.8
condition 6 25 24.0
subroutine 14 17 82.3
pod 3 5 60.0
total 80 168 47.6


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