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         print "top=$top\n";
  61         $top = "" if ($top eq '/');
  62         $top .= "/" if length($top);
  63         my $result = join('', $tpl[0], $body, $tpl[1]);
  64         $result =~
  65         s#<!--\s*\[DIR:\s+(\S+)\s+([^\[\s]+)\s*\]\s*-->#mk_filelist($template_file,$text_file,$1,$2)#egs;
  66
  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);
  71 }
  72
  73 sub read_file
  74 {
  75         my ($filename) = @_;
  76         open my $fh, '<', $filename
  77                 or croak "Cannot open file '$filename' for read: $!";
  78         local $/;
  79         my $res = <$fh>;
  80         return $res;
  81 }
  82
  83 sub write_file
  84 {
  85         my $filename = shift;
  86         open my $fh, '>', $filename
  87                 or croak "Cannot open file '$filename' for write: $!";
  88         print $fh @_
  89                 or croak "Error writing to '$filename': $!";
  90         close $fh
  91                 or croak "Error closing '$filename': $!";
  92 }
  93
  94 sub build_menu
  95 {
  96         my $templ_name= shift;
  97         my $templ_file = shift;
  98         my $menu_file = shift;
  99 # Compute menu name
 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);
 106         my $fh;
 107         open $fh,"<",$menu_name or croak "Cannot open file '$menu_name' for read:
 108                 $!";
 109         local $_;
 110         my $menu="";
 111         while (<$fh>) {
 112                 s/#.*$//;
 113                 next if /^\s*$/;
 114                 if (!/\s*(\S+)\s+(.*)$/) {
 115                         croack("Invalid menu line $_ in $menu_name");
 116                 }
 117                 $menu.=process_item($item_template,$1,$2);
 118         }
 119         return $menu;
 120 }
 121
 122
 123 sub build_menu1
 124 {
 125         my $templ_name = shift;
 126 # Compute menu name
 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);
 133         my $fh;
 134         open $fh,"<",$menu_name or croak "Cannot open file '$menu_name' for read:
 135                 $!";
 136         local $_;
 137         my $menu="";
 138         while (<$fh>) {
 139                 s/#.*$//;
 140                 next if /^\s*$/;
 141                 if (!/\s*(\S+)\s+(.*)$/) {
 142                         croack("Invalid menu line $_ in $menu_name");
 143                 }
 144                 $menu.=process_item($item_template,$1,$2);
 145         }
 146         return $menu;
 147 }
 148
 149
 150
 151 sub process_item
 152 {
 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;
 157 }
 158
 159 sub mk_filelist
 160 {
 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));
 166         my %fileinfo;
 167         my $list="";
 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);
 179                 } elsif (-d $file) {
 180                         print STDERR "..It is directory\n";
 181                         ($title,$descr) = get_html_metadata("$file/index.html");
 182                 } else {
 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}};
 187                         } else {
 188                                 print STDERR ".. no metadata\n";
 189                                 $title = $filename;
 190                                 $descr = "";
 191                         }
 192                 }
 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;
 199                 $list .= $item;
 200         }
 201
 202         return $list;
 203
 204 }
 205
 206 sub get_fileinfo {
 207         my $dir = shift;
 208         my $f;
 209         local $_;
 210         my @out;
 211         open $f,"<$dir/fileinfo";
 212         while (<$f>) {
 213                 if (/(\S+)\s+"([^"]+)"\s+(.*)/) {
 214                         push @out,$1,[$2,$3]
 215                 } else {
 216                         die "Error in $dir/fileinfo - unparsable line $.\n"
 217                 }
 218         }
 219         close $f;
 220         return @out;
 221 }
 222
 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);
 227         $descr=$1 if
 228         ($data=~m#<meta\s+name="?description"?\s+content="([^"]+)">#is);
 229         return ($title,$descr);
 230 }
 231
 232 __END__
 233
 234 =head1 NAME
 235
 236 make_html.pl - make HTML from template and text
 237
 238 =head1 SYNOPSIS
 239
 240  perl make_html.pl <options> <text files>
 241
 242  Options:
 243   --template=<template>  template file
 244   --dest=<dir>           destination directory
 245   --help                 this help
 246   --shadow=nnn                   List of header numbers (1 for h1 etc) which
 247                                                   should be displayed with shadow
 248   --man                  man
 249
 250 =head1 OPTIONS
 251
 252 =over 4
 253
 254 =item B<--template>=template
 255
 256 Use a template file template
 257
 258 =cut