#!/bin/perl -w ############################################################################### # # File: ssi.pl # Version: 1.0 # Purpose: Server-side include simulator for html files. See # http://www.moz.ac.at/user/edwards/software/ssi.html for # details. # Author: Michael Edwards (michael@ccrma.stanford.edu) # Creation Date: 30th May 2000. # ############################################################################### use strict; use File::Copy; ############################################################################### # Globals. Change these according to your needs. my $ServerRoot = "c:/temp/include"; # Extensions of files to be processed. my @SSIExtensions = ("html"); my @Excludes = ("mp3", "wav"); ############################################################################### if ($#ARGV == 1) { die "'$ARGV[0]' does not exist!\n" unless (-d $ARGV[0]); die "'$ARGV[1]' does not exist!\n" unless (-d $ARGV[1]); do_tree($ARGV[0], $ARGV[1]); } elsif ($#ARGV == 0) { die "'$ARGV[0]' must be an existing regular file!\n" unless (-f $ARGV[0]); process_file($ARGV[0], backup($ARGV[0])); } else { (my $program = $0) =~ s|.*/||; die "Usage: $program \n" . " $program \n"; } print "done.\n"; ############################################################################### # Note this function is publicly called with the first two arguments only and # then recursively with the four arguments. sub do_tree { my ($from, $to, $indent, $make_tree) = @_; # e.g. /home/michael & /tmp my $thisdir; my $new_from; my $new_to; my $extension; my $skip; my $file; my $did_file; my $root_to; die "Target directory cannot be the same as source directory.\n" if ($to eq $from); $from = trailing_slash($from); # /home/michael/ $to = trailing_slash($to); # /tmp/ $indent = "" unless defined $indent; my $fileindent = $indent . " "; unless (defined $make_tree) { print "Duplicating directory structure of '$from' to '$to'...."; duplicate_tree($from, $to); print "done.\n"; $root_to = $to . get_last_dir($from) . "/"; # /tmp/michael/ } else { $root_to = $to; } print "$indent"; print "Entering '$from'\n"; opendir($thisdir, $from) or die "do_tree: Can't open directory '$from'.\n"; my @allfiles = readdir $thisdir; closedir $thisdir; @allfiles = sort(@allfiles); foreach $file (@allfiles) { $new_from = $from . $file; # /home/michael/first-file-or-dir $new_to = $root_to . $file; # /tmp/michael/first-file-or-dir # Don't process current or parent directory. next if ($file eq "." || $file eq ".."); $did_file = 0; if (-d $new_from && "$new_from/" ne $to) { do_tree($new_from, $new_to, $indent . " ", 0); next; } print $fileindent; foreach $extension (@SSIExtensions) { if ($file =~ /$extension$/) { print "Processing '$file'\n"; process_file($new_from, $new_to); $did_file = 1; last; } } unless ($did_file) { my $copy = 1; foreach $skip (@Excludes) { if ($file =~ /\.$skip$/) { print "Skipping '$file'\n"; $copy = 0; last; } } if ($copy) { print "Copying '$file'\n"; copy($new_from, $new_to); } } } } ############################################################################### sub process_file { my ($input, $output) = @_; my $fhi; my $fho; my $dir = get_dir($input); my $got_include = 0; open($fhi, $input) or die "process_file: Can't open '$input' for reading.\n"; open($fho, ">$output") or die "process_file: Can't open '$output' for writing.\n"; while (<$fhi>) { if (/(.*?)\s*\s*(.*)/) { $got_include = 1; #print "*** Got '$2' '$3'\n"; # Print stuff before the include, although these should generally # be on their own line with no other text. print $fho $1 if $1; include($2, $3, $fho, $dir); # Print stuff after the include. print $fho "$4\n" if $4; } else { print $fho $_; } } close $fhi; close $fho; } ############################################################################### sub include { my ($type, $file, $stream, $pwd) = @_; my $path; if ($type eq "virtual") { $path = no_trailing_slash($ServerRoot) . "/" . $file; } elsif ($type eq "file") { $path = $file; $path = "$pwd/$file" if $pwd; } else { die "include: include type not recognised: '$type'\n"; } print_file($path, $stream); } ############################################################################### sub print_file { my ($file, $stream) = @_; my $line; my $fhi; select $stream if $stream; open($fhi, $file) or die "print_file: Can't open '$file' for reading.\n"; while (<$fhi>) { print; } close $fhi; select STDOUT; } ############################################################################### # Makes the directory structure present in the first argument (path to a # directory) under the directory in the second argument. Third argument should # always be 1 when called by the user (used for recursive calls with a value of # 0 to avoid duplicating directories). sub duplicate_tree { my ($from, $to, $create_root) = @_; my $file; my $full_path; my $new_path; my $root; my $thisdir; $from = trailing_slash($from); $to = trailing_slash($to); # So that we don't have to pass the third arg. $create_root = 1 unless defined $create_root; opendir($thisdir, $from) or die "duplicate_tree: Can't open directory '$from'.\n"; my @allfiles = readdir $thisdir; closedir $thisdir; if ($create_root) { $root = get_last_dir($from); $root = $to . $root . "/"; unless (-e $root) { mkdir($root, "") or die "duplicate_tree: Can't create directory '$root'.\n"; } } else { $root = $to; } chdir($root) or die "duplicate_tree: Can't cd to '$root'.\n"; foreach $file (@allfiles) { $full_path = $from . $file . "/"; # Don't process current or parent directory or recursively copy the $to # directory (which would result in an infinite loop). next if ($file eq "." || $file eq ".." || $full_path eq $to); if (-d $full_path) { $new_path = $root . $file . "/"; unless (-e $new_path) { #print "Making directory '$new_path'.\n"; mkdir($new_path, "") or die "duplicate_tree: Can't create directory " . "'$new_path'.\n"; } duplicate_tree($full_path, $new_path, 0); } } } ############################################################################### sub backup { my ($file) = @_; $file =~ /(.*)\.(.*)/; return "$1-pre-ssi.$2" if $1; return "$file-pre-ssi"; } ############################################################################### # Returns directory portion of a path minus the trailing slash. sub get_dir { my ($file) = @_; return $1 if ($file =~ m|(.*)/.*|); return ""; } ############################################################################### # Gets the last directory in the path. Note, if the path contains no file at # the end, i.e. it is a path to a directory only, then this should be clarified # by placing a slash at the end of the path before passing it to this function. sub get_last_dir { my ($path) = @_; $path =~ m|.*/(.*)/|; return $1 if $1; die "get_last_dir: No directories given in '$path'.\n"; } ############################################################################### # Returns a string without the trailing slash if there was one there. sub no_trailing_slash { my ($input) = @_; return $1 if $input =~ m|(.*?)/$|; return $input; } ############################################################################### # Opposite of no_trailing_slash. sub trailing_slash { my ($input) = @_; $input .= "/" unless ($input =~ m|/$|); return $input; } ############################################################################### # EOF ssi.pl