#!/usr/local/bin/perl -w # wgen: Combine plain HTML-files with one template to generate a website # Copyright (C) 2000 Jan Ivar Pladsen # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. use strict; use IO::File; use File::Path; use File::Copy; my ( %FILE2TITLE, %FILE2EDITOR, %FILE2EDITOR_EMAIL ); my ( %UPDATED, %CRUMBS ); main(); sub print_help { print STDERR < UPDATED Date of last modification BREADCRUMBS Trail of titles from the pages preceding this. MENU Text fetched from between

and

if they are found right after . TEXT Content of page EDITOR Name of editor in charge of the page EDITOR_EMAIL Email address to reach editor (and maybe others) EOT ; } sub print_editors_help { print STDERR <<'EOT' The editors file is a file with colon separated values. The fields are name of editor, email address of editor, and path. Path may include a filename. Example: # Main editor John Doe:john.doe@mysite.net:/ # Editor for /aktiviteter and all subdirectories (if any) Jane Doe:jane.doe@mysite.net:/finance # Editor for just this page Toby Doe:toby.doe@mysite.net:/collections.html EOT ; } sub _documentation_of_global_variables { # %FILE2TITLE: # # $FILE2TITLE{ "$path/$file" } = $title; # One entry for each html-file. # # %FILE2EDITOR # # $FILE2EDITOR{ $path } = $name_of_editor; # One entry for each editor. The variable $path may include a file or # just one or more directories. # # %FILE2EDITOR_EMAIL # # $FILE2EDITOR_EMAIL{ $path } = $email_of_editor; # One entry for each editor. The variable $path may include a file or # just one or more directories. # } sub main { my ( $configuration_file, $config ); my ( $template_file, $template ); my ( $editors_file ); $configuration_file = process_commandline() || exit; ( $template_file, $editors_file, $config ) = process_configuration_file( $configuration_file ); $template = process_template_file( $template_file ); process_editors_file( $editors_file ); process_directory( $config, '', $template ); } sub process_commandline { $_ = $ARGV[ 0 ] || '--help'; /^--?help/ && do { print_help(); return undef; }; /^--?conf/ && do { print_configuration_help(); return undef; }; /^--?temp/ && do { print_template_help(); return undef; }; /^--?edit/ && do { print_editors_help(); return undef; }; return( $_ ); } sub process_configuration_file { my ( $configuration_file ) = @_; my ( %known_key, $key, $value, %in, %known_language ); my ( $base_directory, $source_directory, $destination_directory ); my ( $language, $template_file, $editors_file, %config ); die unless defined $configuration_file; %known_key = map { $_ => 1 } qw( language base_directory editors_file template_file source_directory destination_directory ); if ( open( FH, $configuration_file ) ) { while ( ) { chomp; s/#.*//; next if /^\s*$/; ( $key, $value ) = split( /\s+/, $_, 2 ); $key =~ s/^\s+//; $value =~ s/^\s+//; # Remove leading and $key =~ s/\s+$//; $value =~ s/\s+$//; # trailing whitespace $in{ $key } = $value if ( $known_key{ $key } ); } close( FH ); } else { die "$configuration_file: $! \n"; } $base_directory = $in{ base_directory } || `pwd`; $base_directory =~ s{/$ }{}x unless ( $base_directory eq '/' ); $template_file = $in{ template_file } || ( print_configuration_help(), exit ); $template_file = "$base_directory/$template_file" unless ( $template_file =~ m{^/} ); $editors_file = $in{ editors_file } || ( print_configuration_help(), exit ); $editors_file = "$base_directory/$editors_file" unless ( $editors_file =~ m{^/} ); $source_directory = $in{ source_directory } || ( print_configuration_help(), exit ); $source_directory = "$base_directory/$source_directory" unless ( $source_directory =~ m{^/} ); $destination_directory = $in{ destination_directory } || ( print_configuration_help(), exit ); $destination_directory = "$base_directory/$destination_directory" unless ( $destination_directory =~ m{^/} ); $language = lc( $in{ language } ) || 'english'; %known_language = map { $_ => 1 } qw( norsk ); $language = 'english' unless $known_language{ $language }; %config = ( 'src' => $source_directory, 'dst' => $destination_directory, ); return ( $template_file, $editors_file, \%config ); } sub process_editors_file { my ( $editors_file ) = @_; my ( $editor, $editor_email, $path ); return unless defined $editors_file; if ( open( FH, $editors_file ) ) { while ( ) { chomp; s/#.*//; next if /^\s*$/; ( $editor, $editor_email, $path ) = split( /:/ ); $path =~ s/\/$// unless ( $path eq '/' ); # Remove trailing / $FILE2EDITOR{ $path } = $editor; $FILE2EDITOR_EMAIL{ $path } = $editor_email; } close( FH ); } } sub process_template_file { my ( $template_file ) = @_; my ( $text, $line, $pre, $key, $post ); my ( $template ); if ( open( FH, $template_file ) ) { $text = ''; while ( ) { $line = $_; while ( $line =~ /%%[^%]+%%/ ) { ( $pre, $key, $post ) = $line =~ /^(.*?) # Text before keyword %%([^%]+)%% # The keyword inside %% %% (.*)$/x; # Text after keyword push( @{ $template->{ 'text' } }, $text . $pre ); $text = ''; push( @{ $template->{ 'key' } }, $key ); $line = $post; } $text .= $line; } push( @{ $template->{ 'text' } }, $text ); close( FH ); } else { warn "Can't open $template_file for reading"; } return ( $template ); } sub process_directory { my ( $config, $path, $template ) = @_; my ( @files_to_be_copied, @html_files, @directories ); my ( $has_index, $menu, $directory ); my ( $src, $dst ); $src = $config->{ src }; $dst = $config->{ dst }; $has_index = read_directory( $src, $path, \@files_to_be_copied, \@html_files, \@directories ); mkpath( "$dst/$path" ); copy_files( $config, $path, \@files_to_be_copied ); if ( $has_index ) { $menu = process_index_file( $config, $path, $template ); make_menu_entries( $config, $path, $menu, \@directories, \@html_files ); process_html_files( $config, $path, $template, $menu, \@html_files ); } for $directory ( @directories ) { process_directory( $config, "$path/$directory", $template ); } } sub read_directory { my ( $src, $path, $files_to_be_copied, $html_files, $directories ) = @_; my ( @filenames, $file, $index_found ); $src .= "/$path" if ( $path ne '' ); opendir( DIR, "$src" ) || ( warn "can't open $src: $!\n", return ); @filenames = readdir( DIR ); closedir( DIR ); $index_found = 0; for $file ( @filenames ) { if ( $file eq 'index.html' ) { $index_found = 1; } elsif ( $file =~ /html$/ || $file =~ /htm$/ ) { push( @{ $html_files }, $file ); } elsif ( $file =~ /~$/ ) { # Ignoring backup files. } elsif ( -d "$src/$file" ) { push( @{ $directories }, $file ) unless ( $file eq '.' || $file eq '..' ); } else { push( @{ $files_to_be_copied }, $file ); } } return( $index_found ); } sub make_menu_entries { my ( $config, $path, $menu, $directoriesref, $html_filesref ) = @_; my ( $line, $dir_file, $dir, $file, $abs_dir, $text ); my ( $src, $dst ); $src = $config->{ src }; $dst = $config->{ dst }; $menu ||= ''; for $line ( split( /\n/, $menu ) ) { ( $dir_file, $text ) = $line =~ /(.+?){ src }; $dst = $config->{ dst }; $src .= "/$path" unless $path eq ''; $dst .= "/$path" unless $path eq ''; for $file ( @{ $files_to_be_copied } ) { copy( "$src/$file", "$dst/$file" ) || die; } } sub process_index_file { my ( $config, $path, $template ) = @_; my ( $file, $Input, $menu, $Fh ); my ( $src, $dst ); $src = $config->{ src }; $dst = $config->{ dst }; $Input = new WebFilter( $config ); $src .= "/$path" unless $path eq ''; $dst .= "/$path" unless $path eq ''; -f "$src/index.html" || ( warn "index.html not found in $src\n", return ); $file = 'index.html'; $Fh = new IO::File ">$dst/$file"; if ( not defined( $Fh ) ) { warn_about_error_on_open_for_write( "$dst/$file" ); return(); } my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks ) = stat( "$src/$file" ); chown( $uid, $gid, "$dst/$file" ); $Input->parse_file( $path, $file ); # $Input->{ 'menu' } = "\n\n" # unless ( defined( $Input->{ 'menu' } ) # and # $Input->{ 'menu' } ne '' ); # '...' etter katalogar i menyen $menu = $Input->{ 'menu' }; $menu =~ s/(index.html\">[^<]+<\/a>)\s*
/$1 ...
/g; $menu =~ s/(index.html\">[^<]+<\/a>)\s*

/$1 ...

/g; $menu =~ s/(index.html\">[^<]+<\/a>)\s*\n/$1 .../g; $Input->{ 'menu' } = $menu; make_breadcrumbs( $path, $file, $Input->{ 'title' } ); $Input->{ 'breadcrumbs' } = get_breadcrumbs( $path, $file ) || 'Problemer med BREADCRUMBS'; ( $Input->{ 'editor' }, $Input->{ 'editor_email' } ) = get_editor_and_email( $path, $file ); $UPDATED{ $Input->{ path } } = $Input->{ updated }; $CRUMBS{ $Input->{ path } } = $Input->{ breadcrumbs }; html( $Fh, $Input, $template ); $Fh->close(); return ( $menu ); } sub process_html_files { my ( $config, $path, $template, $menu, $html_files ) = @_; my ( $file, $Input, $Fh ); my ( $src, $dst ); $src = $config->{ src }; $dst = $config->{ dst }; $Input = new WebFilter( $config ); $src .= "/$path" unless $path eq ''; $dst .= "/$path" unless $path eq ''; for $file ( @{ $html_files } ) { $Fh = new IO::File ">$dst/$file"; if ( not defined( $Fh ) ) { warn_about_error_on_open_for_write( "$dst/$file" ); return(); } my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks ) = stat( "$src/$file" ); chown( $uid, $gid, "$dst/$file" ); $Input->parse_file( $path, $file ); $Input->{ menu } = $menu; make_breadcrumbs( $path, $file, $Input->{ 'title' } ); $Input->{ 'breadcrumbs' } = get_breadcrumbs( $path, $file ) || 'Problemer med BREADCRUMBS'; ( $Input->{ 'editor' }, $Input->{ 'editor_email' } ) = get_editor_and_email( $path, $file ); html( $Fh, $Input, $template ); $Fh->close(); } } sub warn_about_error_on_open_for_write { my ( $dst_file ) = @_; if ( not -e $dst_file ) { warn "$dst_file does not exist and you do not have the rights to create it.\n"; } elsif ( not -w $dst_file ) { # warn "$dst_file is not writable by effective uid/gid.\n"; } elsif ( not -W $dst_file ) { # warn "$dst_file is not writable by real uid/gid.\n"; } else { warn( "$dst_file could not be opened for writing and I don't know why!\n" ); } } sub html { my ( $fh, $Input, $template ) = @_; my ( $tmp, @part, $levels, $cd ); my ( $index, $key, $input ); $tmp = $Input->{ 'path' }; $tmp =~ s{^/}{}; @part = split( m{/}, $tmp ); $levels = scalar( @part ); $levels = 0 if not defined $levels; $cd = '../' x $levels; for $index ( 0 .. scalar @{ $template->{ 'text' } } - 1 ) { if ( defined( $template->{ 'key' }[ $index ] ) ) { $key = lc( $template->{ 'key' }[ $index ] ); if ( defined( $Input->{ $key } ) ) { $input = $Input->{ $key }; } else { print "key: $key $Input->{ title }\n", join "\n", keys %{ $Input };exit; $input = "udefinert: $key"; } } else { $input = ''; } $tmp = $template->{ 'text' }[ $index ]; # Adjusting src in img-tags, using a zero-width negative lookahead assertion. # See man perlre $tmp =~ s/src="(?!http:)/src="$cd/g; $fh->print( $tmp, $input ); } } sub make_breadcrumbs { my ( $path, $file, $title ) = @_; $FILE2TITLE{ "$path/$file" } = $title || 'No title'; } sub get_breadcrumbs { my ( $path, $file ) = @_; my ( @part, $levels, $part, $subpath ); my ( $crumbs, $tmp ); $tmp = $path; $tmp =~ s{^/}{}; @part = split( m{/}, $tmp ); $levels = scalar( @part ); $levels = 0 if not defined $levels; $crumbs = ''; if ( $levels == 0 ) { if ( $file eq 'index.html' ) { $crumbs .= $FILE2TITLE{ "/index.html" }; } else { print "Manglar smule for: $path/$file |\n" unless defined $FILE2TITLE{ "$path/$file" }; $crumbs .= crumb_link( $FILE2TITLE{ "/index.html" }, 0 ) . ' -> ' . $FILE2TITLE{ "$path/$file" }; } } elsif ( $levels == 1 ) { $crumbs .= crumb_link( $FILE2TITLE{ "/index.html" }, $levels ) . ' -> '; if ( $file eq 'index.html' ) { $crumbs .= $FILE2TITLE{ "/$part[ 0 ]/index.html" }; } else { $crumbs .= crumb_link( $FILE2TITLE{ "/$part[ 0 ]/index.html" }, 0 ) . ' -> ' . $FILE2TITLE{ "/$part[ 0 ]/$file" }; } } elsif ( $levels > 1 ) { $crumbs .= crumb_link( $FILE2TITLE{ "/index.html" }, $levels -- ); pop( @part ) if ( $file eq 'index.html' ); for $part ( @part ) { $subpath .= "$part/"; $crumbs .= ' -> ' . crumb_link( $FILE2TITLE{ "/${subpath}index.html" }, $levels -- ); } $crumbs .= ' -> ' . $FILE2TITLE{ "$path/$file" }; } $crumbs .="\n"; return( $crumbs ); } sub get_editor_and_email { my ( $path, $file ) = @_; my ( @path, $editor, $editor_email ); $path =~ s/^\///; @path = split( /\//, $path ); push( @path, $file ); push( @path, 'to_be_popped_first_time' ); do { pop( @path ); $path = '/' . join( '/', @path ); $editor = $FILE2EDITOR{ $path } || ''; $editor_email = $FILE2EDITOR_EMAIL{ $path } || ''; } until ( ( $editor ne '' ) or ( scalar( @path ) == 0 ) ); $editor = 'EDITOR_ERROR' if ( $editor eq '' ); $editor_email = 'EDITOR_EMAIL_ERROR' if ( $editor_email eq '' ); return ( $editor, $editor_email ); } sub crumb_link { my ( $text, $levels ) = @_; my ( $tmp ); $tmp = '' . $text . ''; return( $tmp ); } package WebFilter; sub new { my ( $proto, $configuration ) = @_; my ( $class, $self ); my ( $src ); $src = $configuration->{ src }; $class = ref( $proto ) || $proto; $self->{ 'src' } = $src || die "No source"; bless ( $self, $class ); return( $self ); } sub parse_file { my ( $self, $path, $file ) = @_; my ( $src, $input, $body ); my ( $title, $menu, $text ); $self->{ url } = "$path/$file"; $src = $self->{ src }; $src .= "/$path" unless ( $path eq '' ); open( FH, "$src/$file" ) || die; $input = join ( '', ); close( FH ); ( $title ) = $input =~ /]*> # title start-tag (.*?) # contents of title <\/title>/sxi; # title end-tag ( $body ) = $input =~ /]*> # body start-tag (.+?) # contents of body <\/body>/sxi; # body end-tag $menu = ''; ( $menu, $body ) = extract_menu( $body ) if ( $file =~ /^\s*index.html\s*$/ ); $text = $body; $self->{ 'path' } = $path; $self->{ 'updated' } = last_updated( $src, $file ); $self->{ 'title' } = $title; $self->{ 'menu' } = "\n\n" . $menu . "\n"; $self->{ 'text' } = "\n\n" . $text . "\n"; } sub extract_menu { my ( $body ) = @_; my ( $menu, $new_body ); if ( $body =~ /^\s*

/is ) { ( $menu, $new_body ) = $body =~ /^\s* # Leading space

(.*?)

# Menu between

and

\s* # Space (.*)$/sxi; # New body } $menu ||= ''; $body = $new_body if ( defined $new_body ); return ( $menu, $body ); } sub last_updated { my ( $path, $file ) = @_; my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size ); my ( $atime, $mtime, $ctime, $blksize, $blocks ); my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ); my ( @mon, @wday ); ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks ) = stat( "$path/$file" ); ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime( $mtime ); $year += 1900; $hour =~ s/^(\d)$/0$1/; $min =~ s/^(\d)$/0$1/; @mon = qw( January February March April May June July August September October November December ); @wday = qw( sunday monday tuesday wednesday thursday friday saturday ); return "$wday[ $wday ] $mon[ $mon ] $mday. $year at $hour:$min"; @mon = qw( januar februar mars april mai juni juli august september oktober november desember ); @wday = qw( s�ndag mandag tirsdag onsdag torsdag fredag l�rdag ); return "$wday[ $wday ] $mday.$mon[ $mon ] $year klokka $hour:$min"; }