7 use POSIX qw(strftime);
11 "template=s" => \my $template_file,
12 "dest=s" => \my $destdir,
13 "help|?" => \my $help,
14 "shadow=s" => \my $shadowheaders,
15 "man" => \my $man) or pod2usage(2);
16 pod2usage(1) if $help;
17 pod2usage(-exitstatus=>0, -verbose=>2) if $man;
18 pod2usage(2) if !(-d $destdir) || !defined($template_file);
20 my ($destvol, $dest_dir) = File::Spec->splitpath($destdir, 1);
21 my @template = split(/<!--\s*\[TEXT\]\s*-->/, read_file($template_file));
23 for (@template) { $lastchange = 1 if /\@LASTCHANGE\@/; }
26 open my $fh, '-|', 'cvs', 'log', '-rHEAD', @ARGV
27 or die "Cannot cvs log: $!";
30 $fn = $1 if /^Working file:\s*(.*)/;
31 $lastchange{$fn} = strftime("%F %T %Z", localtime(str2time($1)))
32 if m#^date: (\d{4}/\d\d/\d\d \d\d:\d\d:\d\d)#;
39 s/<!--\s*\[MENU:\s*(\S+)\s*,\s*(\S+)\s*\]\s*-->/build_menu($template_file,$1,$2)/ge;
46 for my $text_file (@ARGV) {
47 pod2usage(2) if File::Spec->file_name_is_absolute($text_file);
48 my ($textvol, $textdir, $textname) = File::Spec->splitpath($text_file);
49 my $text = read_file($text_file);
50 my ($head, $body_attrs, $body) = ($text =~ m#<head>\s*(.*?)\s*</head>.*<body([^>]*)>\s*(.*?)\s*</body>#is);
51 my ($before_title, $title, $after_title) = ($head =~ m#(.*)<title>(.*?)</title>(.*)#is);
53 if (defined $shadowheaders) {
54 $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 $tpl[0] =~ s#(<title\b)#$before_title$1#is;
57 $tpl[0] =~ s#(</title>)#$title$1$after_title#is;
58 $tpl[0] =~ s#(<body\b)#$1$body_attrs#is if $body_attrs;
59 my $top = File::Spec::Unix->abs2rel('', $textdir);
61 $top = "" if ($top eq '/');
62 $top .= "/" if length($top);
63 my $result = join('', $tpl[0], $body, $tpl[1]);
65 s#<!--\s*\[DIR:\s+(\S+)\s+([^\[\s]+)\s*\]\s*-->#mk_filelist($template_file,$text_file,$1,$2)#egs;
67 $result =~ s#\@TOP\@#$top#g;
68 $result =~ s#\@LASTCHANGE\@#$lastchange{$text_file}# if $lastchange;
69 my $resdir = File::Spec->catdir($dest_dir, $textdir);
70 write_file(File::Spec->catpath($destvol, $resdir, $textname), $result);
76 open my $fh, '<', $filename
77 or croak "Cannot open file '$filename' for read: $!";
86 open my $fh, '>', $filename
87 or croak "Cannot open file '$filename' for write: $!";
89 or croak "Error writing to '$filename': $!";
91 or croak "Error closing '$filename': $!";
96 my $templ_name= shift;
97 my $templ_file = shift;
98 my $menu_file = shift;
100 my $menu_name = $templ_name;
101 $menu_name =~ s#/[^/]+$#/$menu_file#;
102 # compute menu item template (language independent)
103 my $item_name = $templ_name;
104 $item_name =~ s#/[^/]+$#/$templ_file#;
105 my $item_template = read_file($item_name);
107 open $fh,"<",$menu_name or croak "Cannot open file '$menu_name' for read:
114 if (!/\s*(\S+)\s+(.*)$/) {
115 croack("Invalid menu line $_ in $menu_name");
117 $menu.=process_item($item_template,$1,$2);
125 my $templ_name = shift;
127 my $menu_name = $templ_name;
128 $menu_name =~ s/\.[^.]+$/.mnu/;
129 # compute menu item template (language independent)
130 my $item_name = $templ_name;
131 $item_name =~ s#/[^/]+$#/menu1.tpl#;
132 my $item_template = read_file($item_name);
134 open $fh,"<",$menu_name or croak "Cannot open file '$menu_name' for read:
141 if (!/\s*(\S+)\s+(.*)$/) {
142 croack("Invalid menu line $_ in $menu_name");
144 $menu.=process_item($item_template,$1,$2);
153 my ($item_template,$link_uri,$item_text) = @_;
154 $item_template =~ s/\@LINK\@/$link_uri/g;
155 $item_template =~ s/\@TEXT\@/$item_text/g;
156 return $item_template;
161 my ($template_file,$text_file,$pattern,$item_template)=@_;
162 my ($textvol, $file_dir, $textname) = File::Spec->splitpath($text_file);
163 $template_file =~ s/[^\/]+$/$item_template/;
164 my $template = read_file($template_file);
165 my @files=map(glob,map("$file_dir$_", split "," ,$pattern));
168 print STDERR "Processing directory '$pattern' in the file $text_file\n";
169 foreach my $file (@files) {
170 print STDERR ".matching file $file\n";
171 next if $file eq $text_file;
172 my ($title,$descr,$filename);
173 $filename=$1 if $file=~/([^\/]+)$/;
174 next if $filename eq "CVS";
175 next if $filename eq "fileinfo";
176 if ($file =~ /\.html?$/) {
177 print STDERR "..It is html\n";
178 ($title,$descr)=get_html_metadata($file);
180 print STDERR "..It is directory\n";
181 ($title,$descr) = get_html_metadata("$file/index.html");
183 get_fileinfo($file_dir) if (!%fileinfo);
184 if ($fileinfo{$file}) {
185 print STDERR ".. it is described in fileinfo\n";
186 ($title,$descr) = @{$fileinfo{$file}};
188 print STDERR ".. no metadata\n";
193 my $link = substr($file,length($file_dir));
194 my $item = $template;
195 $item =~s/\@LINK\@/$link/gs;
196 $item =~s/\@NAME\@/$filename/gs;
197 $item =~s/\@TITLE\@/$title/gs;
198 $item =~s/\@DESCR\@/$descr/gs;
211 open $f,"<$dir/fileinfo";
213 if (/(\S+)\s+"([^"]+)"\s+(.*)/) {
216 die "Error in $dir/fileinfo - unparsable line $.\n"
223 sub get_html_metadata {
224 my $data = read_file(shift);
225 my ($title,$descr)=(undef,undef);
226 $title=$1 if ($data=~m#<title>([^<]*)</title>#is);
228 ($data=~m#<meta\s+name="?description"?\s+content="([^"]+)">#is);
229 return ($title,$descr);
236 make_html.pl - make HTML from template and text
240 perl make_html.pl <options> <text files>
243 --template=<template> template file
244 --dest=<dir> destination directory
246 --shadow=nnn List of header numbers (1 for h1 etc) which
247 should be displayed with shadow
254 =item B<--template>=template
256 Use a template file template