File Coverage

blib/lib/Pandoc/Filter/HeaderIdentifiers.pm
Criterion Covered Total %
statement 44 44 100.0
branch 14 18 77.7
condition 8 11 72.7
subroutine 13 13 100.0
pod 4 5 80.0
total 83 91 91.2


line stmt bran cond sub pod time code
1             package Pandoc::Filter::HeaderIdentifiers;
2 1     1   968 use strict;
  1         3  
  1         35  
3 1     1   8 use warnings;
  1         2  
  1         29  
4 1     1   23 use 5.010;
  1         4  
5              
6             our $VERSION = '0.34';
7              
8 1     1   6 use parent 'Pandoc::Filter';
  1         2  
  1         8  
9 1     1   47 use Pandoc::Elements;
  1         2  
  1         470  
10              
11             our @EXPORT = qw(header_identifier InPandocHeaderIdentifier);
12              
13             ## FUNCTIONS
14              
15             sub header_identifier {
16 12     12 1 123 my $id = shift;
17 12         22 my $ids = shift;
18              
19             # stringify inline elements except footnotes
20             $id = join '', @{
21 12 100       35 pandoc_query( $id, sub {
22 7 100   7   34 $_->is_inline and $_->name ne 'Note' ? $_->string : \undef
    50          
23             })
24 5         29 } if ref $id;
25              
26             # Convert all alphabetic characters to lowercase.
27 12         44 $id = lc $id;
28              
29             # these steps not strictly documented but it is how Pandoc works
30 12         6176 $id =~ s/\p{^InPandocHeaderIdOrWs}+//g;
31 12         825 $id =~ s/\p{WhiteSpace}+$//;
32              
33             # Replace all spaces and newlines with hyphens.
34 12         29 $id =~ s/\p{WhiteSpace}+/-/g;
35              
36             # Remove all punctuation, except underscores, hyphens, periods, and whitespace.
37 12         39 $id =~ s/\p{^InPandocHeaderIdentifier}//g;
38              
39             # remove everything up to the first letter
40 12         512 $id =~ s/^[_.0-9-]+//;
41              
42             # if nothing is left, use the identifier 'section'
43 12   100     113 $id ||= 'section';
44              
45             # add counter on repeated identifiers
46 12 100 100     51 if ($ids and $ids->{$id}++) {
47 4         15 $id .= '-' . ($ids->{$id}-1);
48             }
49              
50 12         57 return $id;
51             }
52              
53             ## METHODS
54              
55             sub new {
56 1     1 1 27 bless { }, shift;
57             }
58              
59             sub apply {
60 1     1 1 7 my ($self, $doc) = @_;
61              
62 1 50       8 my $ids = @_ > 2 ? $_[2] : {};
63              
64             # collect existing identifiers
65             $doc->walk( Header => sub {
66 5     5   18 my $id = $_->id;
67 5 100 66     47 return if $id !~ /^\p{InPandocHeaderIdentifier}+$/ or $id !~ /^\p{Letter}/;
68 1 50       746 if ($id =~ /^(.+)-(\d+)$/) {
69 1         4 $id = $1;
70 1 50 33     8 $ids->{$id} = $2 unless defined $ids->{$id} and $ids->{$id} > $2;
71             }
72 1         9 $ids->{$id}++;
73 1         20 } );
74              
75             # add missing identifiers
76             $doc->walk( Header => sub {
77 5 100   5   17 $_[0]->id( header_identifier( $_[0]->content, $ids ) ) if $_[0]->id eq '';
78 1         24 });
79              
80 1         10 $doc;
81             }
82            
83             ## CHARACTER PROPERTIES
84              
85             sub InPandocHeaderIdentifier {
86 4     4 1 3032 return "+utf8::Letter\n-utf8::Uppercase_Letter\n-utf8::Titlecase_Letter\n0030 0039\n005F\n002d 002e\n";
87             }
88              
89             sub InPandocHeaderIdOrWs {
90 1     1 0 174 return "+utf8::Whitespace\n+utf8::Letter\n-utf8::Uppercase_Letter\n-utf8::Titlecase_Letter\n0030 0039\n005F\n002d 002e\n";
91             }
92              
93             __END__