]> git.stg.codes - stg.git/blob - doc/xslt/fo/pdf2index
Merge branch 'naffanya-dev'
[stg.git] / doc / xslt / fo / pdf2index
1 #!/usr/bin/perl -- # -*- Perl -*-
2
3 # this needs some cleanup...
4
5 my $PSTOTEXT = "pstotext";
6
7 my $pdf = shift @ARGV;
8
9 my $index = "";
10 my $inindex = 0;
11 open (F, "$PSTOTEXT $pdf |");
12 while (<F>) {
13     if (/^<\/index/) {
14         $index .= $_;
15         $inindex = 0;
16     }
17     $inindex = 1 if /^<index/;
18
19     if ($inindex) {
20         $index .= $_ if /^\s*</;
21     }
22 }
23
24 my $cindex = "";
25 while ($index =~ /^(.*?)((<phrase role=\"pageno\">.*?<\/phrase>\s*)+)/s) {
26     $cindex .= $1;
27     $_ = $2;
28     $index = $'; # '
29
30     my @pages = m/<phrase role=\"pageno\">.*?<\/phrase>\s*/sg;
31
32     # Expand ranges
33     if ($#pages >= 0) {
34         my @mpages = ();
35         foreach my $page (@pages) {
36             my $pageno = &pageno($page);
37             if ($pageno =~ /^([0-9]+)[^0-9]([0-9]+)$/) { # funky -
38                 for (my $count = $1; $count <= $2; $count++) {
39                     push (@mpages, "<phrase role=\"$pageno\">$count</phrase>");
40                 }
41             } else {
42                 push (@mpages, $page);
43             }
44         }
45         @pages = sort rangesort @mpages;
46     }
47
48     # Remove duplicates...
49     if ($#pages > 0) {
50         my @mpages = ();
51         my $current = "";
52         foreach my $page (@pages) {
53             my $pageno = &pageno($page);
54             if ($pageno ne $current) {
55                 push (@mpages, $page);
56                 $current = $pageno;
57             }
58         }
59         @pages = @mpages;
60     }
61
62     # Collapse ranges...
63     if ($#pages > 1) {
64         my @cpages = ();
65         while (@pages) {
66             my $count = 0;
67             my $len = &rangelen($count, @pages);
68             if ($len <= 2) {
69                 my $page = shift @pages;
70                 push (@cpages, $page);
71             } else {
72                 my $fpage = shift @pages;
73                 my $lpage = "";
74                 while ($len > 1) {
75                     $lpage = shift @pages;
76                     $len--;
77                 }
78                 my $fpno = &pageno($fpage);
79                 my $lpno = &pageno($lpage);
80                 $fpage =~ s/>$fpno</>${fpno}-$lpno</s;
81                 push (@cpages, $fpage);
82             }
83         }
84         @pages = @cpages;
85     }
86
87     my $page = shift @pages;
88     $page =~ s/\s*$//s;
89     $cindex .= $page;
90     while (@pages) {
91         $page = shift @pages;
92         $page =~ s/\s*$//s;
93         $cindex .= ", $page";
94     }
95 }
96 $cindex .= $index;
97
98 print "$cindex\n";
99
100 sub pageno {
101     my $page = shift;
102
103     $page =~ s/^<phrase.*?>//;
104     $page =~ s/^<link.*?>//;
105
106     return $1 if $page =~ /^([^<>]+)/;
107     return "?";
108 }
109
110 sub rangesort {
111     my $apno = &pageno($a);
112     my $bpno = &pageno($b);
113
114     # Make sure roman pages come before arabic ones, otherwise sort them in order
115     return -1 if ($apno !~ /^\d+/ && $bpno =~ /^\d+/);
116     return  1 if ($apno =~ /^\d+/ && $bpno !~ /^\d+/);
117     return $apno <=> $bpno;
118 }
119
120 sub rangelen {
121     my $count = shift;
122     my @pages = @_;
123     my $len = 1;
124     my $inrange = 1;
125
126     my $current = &pageno($pages[$count]);
127     while ($count < $#pages && $inrange) {
128         $count++;
129         my $next = &pageno($pages[$count]);
130         if ($current + 1 eq $next) {
131             $current = $next;
132             $inrange = 1;
133             $len++;
134         } else {
135             $inrange = 0;
136         }
137     }
138
139     return $len;
140 }