]> www.wagner.pp.ru Git - sites/home_page.git/blob - scripts/make_html.pl
Описана смерть собаки Муси
[sites/home_page.git] / scripts / make_html.pl
1 use strict;
2 use Getopt::Long;
3 use Pod::Usage;
4 use File::Spec;
5 use File::Spec::Unix;
6 use locale;
7 use POSIX qw(strftime);
8 use Date::Parse;
9 use Carp;
10 use utf8;
11 GetOptions(
12         "template=s" => \my $template_file,
13         "dest=s" => \my $destdir,
14         "help|?" => \my $help,
15         "shadow=s" => \my $shadowheaders,
16         "man" => \my $man) or pod2usage(2);
17 pod2usage(1) if $help;
18 pod2usage(-exitstatus=>0, -verbose=>2) if $man;
19 pod2usage(2) if !(-d $destdir) || !defined($template_file);
20
21 my ($destvol, $dest_dir) = File::Spec->splitpath($destdir, 1);
22 my @template = split(/<!--\s*\[TEXT\]\s*-->/, read_file($template_file));
23 my $lastchange;
24 for (@template) { $lastchange = 1 if /\@LASTCHANGE\@/; }
25 my %lastchange;
26 if ($lastchange) {
27         open my $fh, '-|', 'cvs', 'log', '-rHEAD', @ARGV
28                 or die "Cannot cvs log: $!";
29         my $fn;
30         while (<$fh>) {
31                 $fn = $1 if /^Working file:\s*(.*)/;
32                 $lastchange{$fn} = strftime("%F %T %Z", localtime(str2time($1)))
33                         if m#^date: (\d{4}/\d\d/\d\d \d\d:\d\d:\d\d)#;
34         }
35 }
36
37 my $menu=undef;
38 # generate menu
39 for (@template) {
40                 s/<!--\s*\[MENU:\s*(\S+)\s*,\s*(\S+)\s*\]\s*-->/build_menu($template_file,$1,$2)/ge;
41 }               
42
43         
44
45
46
47 for my $text_file (@ARGV) {
48         pod2usage(2) if File::Spec->file_name_is_absolute($text_file);
49         my ($textvol, $textdir, $textname) = File::Spec->splitpath($text_file);
50         my $text = read_file($text_file);
51         my ($head, $body_attrs, $body) = ($text =~ m#<head>\s*(.*?)\s*</head>.*<body([^>]*)>\s*(.*?)\s*</body>#is);
52         my ($before_title, $title, $after_title) = ($head =~ m#(.*)<title>(.*?)</title>(.*)#is);
53         my @tpl = @template;
54         if (defined $shadowheaders) {
55                 $body =~ s#<h([$shadowheaders])>(.*?)</h\1>#<h$1 class="shadow"><div class="shadowbox"><div class="headertext">$2</div><div class="headershadow">$2</div></div></h$1>#isg;
56         }       
57         $tpl[0] =~ s#(<title\b)#$before_title$1#is;
58         $tpl[0] =~ s#(</title>)#$title$1$after_title#is;
59         $tpl[0] =~ s#(<body\b)#$1$body_attrs#is if $body_attrs;
60         my $top = File::Spec::Unix->abs2rel('', $textdir);
61         print "top=$top\n";
62         $top = "" if ($top eq '/');
63         $top .= "/" if length($top);
64         my $result = join('', $tpl[0], $body, $tpl[1]);
65         $result =~
66         s#<!--\s*\[DIR:\s+(\S+)\s+([^\[\s]+)\s*\]\s*-->#mk_filelist($template_file,$text_file,$1,$2)#egs;
67         
68         $result =~ s#\@TOP\@#$top#g;
69         $result =~ s#\@LASTCHANGE\@#$lastchange{$text_file}# if $lastchange;
70         my $resdir = File::Spec->catdir($dest_dir, $textdir);
71         write_file(File::Spec->catpath($destvol, $resdir, $textname), $result);
72 }
73
74 sub read_file
75 {
76         my ($filename) = @_;
77         open my $fh, '<', $filename
78                 or croak "Cannot open file '$filename' for read: $!";
79         local $/;
80         my $res = <$fh>;
81         return $res;
82 }
83
84 sub write_file
85 {
86         my $filename = shift;
87         open my $fh, '>', $filename
88                 or croak "Cannot open file '$filename' for write: $!";
89         print $fh @_
90                 or croak "Error writing to '$filename': $!";
91         close $fh
92                 or croak "Error closing '$filename': $!";
93 }
94
95 sub build_menu 
96 {
97         my $templ_name= shift;
98         my $templ_file = shift;
99         my $menu_file = shift;
100 # Compute menu name
101         my $menu_name = $templ_name;
102         $menu_name =~ s#/[^/]+$#/$menu_file#;
103 # compute menu item template (language independent)
104         my $item_name = $templ_name; 
105         $item_name =~ s#/[^/]+$#/$templ_file#;
106         my $item_template = read_file($item_name);
107         my $fh;
108         open $fh,"<",$menu_name or croak "Cannot open file '$menu_name' for read:
109                 $!";
110         local $_;
111         my $menu="";
112         while (<$fh>) {
113                 s/#.*$//;
114                 next if /^\s*$/;
115                 if (!/\s*(\S+)\s+(.*)$/) {
116                         croack("Invalid menu line $_ in $menu_name");
117                 }       
118                 $menu.=process_item($item_template,$1,$2);
119         }
120         return $menu;
121
122
123
124 sub build_menu1 
125 {
126         my $templ_name = shift;
127 # Compute menu name
128         my $menu_name = $templ_name;
129         $menu_name =~ s/\.[^.]+$/.mnu/;
130 # compute menu item template (language independent)
131         my $item_name = $templ_name; 
132         $item_name =~ s#/[^/]+$#/menu1.tpl#;
133         my $item_template = read_file($item_name);
134         my $fh;
135         open $fh,"<",$menu_name or croak "Cannot open file '$menu_name' for read:
136                 $!";
137         local $_;
138         my $menu="";
139         while (<$fh>) {
140                 s/#.*$//;
141                 next if /^\s*$/;
142                 if (!/\s*(\S+)\s+(.*)$/) {
143                         croack("Invalid menu line $_ in $menu_name");
144                 }       
145                 $menu.=process_item($item_template,$1,$2);
146         }
147         return $menu;
148
149
150
151
152 sub process_item 
153 {
154         my ($item_template,$link_uri,$item_text) = @_;
155         $item_template =~ s/\@LINK\@/$link_uri/g;
156         $item_template =~ s/\@TEXT\@/$item_text/g;
157         return $item_template;
158 }       
159
160 sub mk_filelist 
161 {       
162         my ($template_file,$text_file,$pattern,$item_template)=@_;
163         my ($textvol, $file_dir, $textname) = File::Spec->splitpath($text_file);
164         $template_file =~ s/[^\/]+$/$item_template/;
165         my $template = read_file($template_file);
166         my @files=map(glob,map("$file_dir$_", split "," ,$pattern));
167         my %fileinfo;
168         my $list="";
169         print STDERR "Processing directory '$pattern' in the file $text_file\n";
170         foreach my $file (@files) {
171                 print STDERR ".matching file $file\n"; 
172                 next if $file eq $text_file;
173                 my ($title,$descr,$filename);
174                 $filename=$1 if $file=~/([^\/]+)$/;
175                 next if $filename eq "CVS";
176                 next if $filename eq "fileinfo";
177                 if ($file =~ /\.html?$/) {
178                         print STDERR "..It is html\n"; 
179                         ($title,$descr)=get_html_metadata($file);
180                 } elsif (-d $file) {
181                         print STDERR "..It is directory\n";
182                         ($title,$descr) = get_html_metadata("$file/index.html");
183                 } else {        
184                         get_fileinfo($file_dir) if (!%fileinfo);
185                         if ($fileinfo{$file}) {
186                                 print STDERR ".. it is described in fileinfo\n";
187                                 ($title,$descr) = @{$fileinfo{$file}};
188                         } else {
189                                 print STDERR ".. no metadata\n";
190                                 $title = $filename;
191                                 $descr = "";
192                         }
193                 }       
194                 my $link = substr($file,length($file_dir));
195                 my $item = $template;
196                 $item =~s/\@LINK\@/$link/gs;
197                 $item =~s/\@NAME\@/$filename/gs;
198                 $item =~s/\@TITLE\@/$title/gs;
199                 $item =~s/\@DESCR\@/$descr/gs; 
200                 $list .= $item;
201         }                       
202
203         return $list;           
204
205 }
206
207 sub get_fileinfo {
208         my $dir = shift;
209         my $f;
210         local $_;
211         my @out;
212         open $f,"<$dir/fileinfo";
213         while (<$f>) {
214                 if (/(\S+)\s+"([^"]+)"\s+(.*)/) {
215                         push @out,$1,[$2,$3]
216                 } else {
217                         die "Error in $dir/fileinfo - unparsable line $.\n"
218                 }
219         }
220         close $f;
221         return @out;
222 }               
223
224 sub get_html_metadata {
225         my $data = read_file(shift);
226         my ($title,$descr)=(undef,undef);
227         $title=$1 if ($data=~m#<title>([^<]*)</title>#is); 
228         $descr=$1 if
229         ($data=~m#<meta\s+name="?description"?\s+content="([^"]+)">#is);
230         return ($title,$descr); 
231 }
232
233 __END__
234
235 =head1 NAME
236
237 make_html.pl - make HTML from template and text
238
239 =head1 SYNOPSIS
240
241  perl make_html.pl <options> <text files>
242
243  Options:
244   --template=<template>  template file
245   --dest=<dir>           destination directory
246   --help                 this help
247   --shadow=nnn                   List of header numbers (1 for h1 etc) which
248                                                   should be displayed with shadow
249   --man                  man
250
251 =head1 OPTIONS
252
253 =over 4
254
255 =item B<--template>=template
256
257 Use a template file template
258
259 =cut