1 | #! /usr/bin/perl -w
|
---|
2 |
|
---|
3 | # convert_toc.pl converts old <<TOC>> marked up files to use the new
|
---|
4 | # <Section> syntax (suitable for processing by HTMLPlug -description_tags
|
---|
5 |
|
---|
6 | use File::Basename;
|
---|
7 |
|
---|
8 | my $level = 0;
|
---|
9 |
|
---|
10 | sub main {
|
---|
11 | open STDIN, "<$ARGV[0]" or die "$ARGV[0]: $!\n";
|
---|
12 | open STDOUT, ">$ARGV[1]" or die "$ARGV[1]: $!\n";
|
---|
13 |
|
---|
14 | my $dirname = &File::Basename::dirname($ARGV[0]);
|
---|
15 |
|
---|
16 | my $content = "";
|
---|
17 |
|
---|
18 | while (<STDIN>) {
|
---|
19 | $_ =~ s/[\cJ\cM]+$/\n/;
|
---|
20 | $content .= $_;
|
---|
21 | }
|
---|
22 |
|
---|
23 | # fix images
|
---|
24 | $content =~ s/<<I>>\s*(\w+\.(?:png|jpe?g|gif))\s*(.*?)<\/p>/rename_image_old($1, $2, $dirname)/iegs;
|
---|
25 | $content =~ s/<img\s+src=\"?(\w+\.(?:png|jpe?g|gif))\"?/rename_image($1, $dirname)/iegs;
|
---|
26 |
|
---|
27 | # process section title
|
---|
28 | $content =~ s/(?:<P[^>]*>|<BR>)(?:\s*<\/?[^>]*>)*?<<TOC(\d+)>>(.*?)(?=<\/?P[^>]*>|<BR>)/
|
---|
29 | process_toc ($1, $2)/sige;
|
---|
30 |
|
---|
31 | # close the remaining sections
|
---|
32 | my $section_ending = "<!--\n";
|
---|
33 | for (my $j = 0; $j < $level; $j++) {
|
---|
34 | $section_ending .= "</Section>\n";
|
---|
35 | }
|
---|
36 | $section_ending .= "-->\n";
|
---|
37 | $content =~ s/(<\/body>)/$section_ending.$1/sie;
|
---|
38 |
|
---|
39 | print STDOUT $content;
|
---|
40 | close STDOUT; close STDIN;
|
---|
41 | }
|
---|
42 |
|
---|
43 | sub process_toc {
|
---|
44 | my ($thislevel, $title) = @_;
|
---|
45 | my $toc = '';
|
---|
46 |
|
---|
47 | $title =~ s/<[^>]+>//sg;
|
---|
48 | $title =~ s/^\s+//s;
|
---|
49 | $title =~ s/\s+$//s;
|
---|
50 | $title =~ s/\n/ /sg;
|
---|
51 |
|
---|
52 | $toc .= "\n<!--\n";
|
---|
53 |
|
---|
54 | if ($thislevel <= $level) {
|
---|
55 | for (my $i = 0; $i < ($level-$thislevel+1); $i++) {
|
---|
56 | $toc .= "</Section>\n";
|
---|
57 | }
|
---|
58 | }
|
---|
59 |
|
---|
60 | $toc .= "<Section>\n".
|
---|
61 | " <Description>\n".
|
---|
62 | " <Metadata name=\"Title\">$title</Metadata>\n".
|
---|
63 | " </Description>\n".
|
---|
64 | "-->\n";
|
---|
65 |
|
---|
66 | $level = $thislevel;
|
---|
67 |
|
---|
68 | return $toc;
|
---|
69 | }
|
---|
70 |
|
---|
71 | sub rename_image_old {
|
---|
72 | my ($image_name, $following_text, $dirname) = @_;
|
---|
73 |
|
---|
74 | &rename_image($image_name, $dirname);
|
---|
75 |
|
---|
76 | return "<center><img src=\"$image_name\"><br>$following_text<\/center><\/p>\n";
|
---|
77 | }
|
---|
78 |
|
---|
79 |
|
---|
80 | # may need to rename image files if case isn't consistent
|
---|
81 | # (i.e. collections prepared on windows may have images named
|
---|
82 | # AAA.GIF which are linked into the HTML as aaa.gif)
|
---|
83 | sub rename_image {
|
---|
84 | my ($image_name, $dirname) = @_;
|
---|
85 |
|
---|
86 |
|
---|
87 | if (!-e "$dirname/$image_name") {
|
---|
88 |
|
---|
89 | my ($pre, $ext) = $image_name =~ /^([^\.]+)\.(.*)$/;
|
---|
90 | my $image_name_uc = uc($image_name);
|
---|
91 | my $image_name_lc = lc($image_name);
|
---|
92 | my $image_name_ul = uc($pre) . "." . lc($ext);
|
---|
93 | my $image_name_lu = lc($pre) . "." . uc($ext);
|
---|
94 |
|
---|
95 | if (-e "$dirname/$image_name_uc") {
|
---|
96 | print STDERR "renaming $dirname/$image_name_uc --> $dirname/$image_name\n";
|
---|
97 | rename ("$dirname/$image_name_uc", "$dirname/$image_name");
|
---|
98 |
|
---|
99 | } elsif (-e "$dirname/$image_name_lc") {
|
---|
100 | print STDERR "renaming $dirname/$image_name_lc --> $dirname/$image_name\n";
|
---|
101 | rename ("$dirname/$image_name_lc", "$dirname/$image_name");
|
---|
102 |
|
---|
103 | } elsif (-e "$dirname/$image_name_ul") {
|
---|
104 | print STDERR "renaming $dirname/$image_name_ul --> $dirname/$image_name\n";
|
---|
105 | rename ("$dirname/$image_name_ul", "$dirname/$image_name");
|
---|
106 |
|
---|
107 | } elsif (-e "$dirname/$image_name_lu") {
|
---|
108 | print STDERR "renaming $dirname/$image_name_lu --> $dirname/$image_name\n";
|
---|
109 | rename ("$dirname/$image_name_lu", "$dirname/$image_name");
|
---|
110 |
|
---|
111 | } else {
|
---|
112 | print STDERR "ERROR**** $dirname/$image_name could not be found\n";
|
---|
113 | if (open (ERROR, ">>error.txt")) {
|
---|
114 | print ERROR "ERROR**** $dirname/$image_name could not be found\n";
|
---|
115 | close ERROR;
|
---|
116 | }
|
---|
117 | }
|
---|
118 | }
|
---|
119 | return "<img src=\"$image_name\"";
|
---|
120 | }
|
---|
121 |
|
---|
122 |
|
---|
123 |
|
---|
124 | &main;
|
---|