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