#!/usr/bin/perl # script to insert a PICS header in an HTML file, just prior # to the end or the header () # Copyright 1996 Andrew Daviel, Vancouver-Webpages.com # You may do what you like with this except sell it or say you wrote it. # This is free software. No warranty is expressed or implied. # *** WARNING - This script modifies HTML documents in-place. Back up # *** your pages before using. The author takes no responsibility for any # *** damage to files that may occur as a result of using this script. if (@ARGV[0] =~ /^-\w/) { $arg = shift(@ARGV) ; } if ($arg eq "-R") { $force = 1 ; } if ($arg eq "-h") { print < Text in is inserted just prior to the tag in . The ownership and permissions of the old file are preserved. The optional argument "-R" causes existing PICS headers to be replaced. If a PICS header already exists, a warning is generated. Typical usage to tag a whole site: find /usr/local/etc/httpd/htdocs -name "*.html" -exec $0 {} PICS.general \\; *** WARNING - This script modifies HTML documents in-place. Back up *** your pages before using. The author takes no responsibility for any *** damage to files that may occur as a result of using this script. EOT exit ; } $f = @ARGV[0] ; $m = @ARGV[1] ; $t = "/tmp/add-meta.tmp" ; if (!$f || !$m) { print <) { if (/http-equiv\s*=\W*PICS-Label/i) { $mpics++ ; } } close (MOD) ; if ($force) {$force = "-R" ; } if (!$mpics && !$force) { print "ERROR - the file $m does not appear to contain a PICS label\n"; exit ; } print "Executing 'find $root $access -name \"$html\" -exec $0 $force {} $m \\;'\n" ; system("find $root $access -name \"$html\" -exec $0 $force {} $m \\;") ; exit ; } } #print "Modify file $f, add text from $m\n"; open (FILE,$f) || die "Can't open input file $f" ; @fstat=stat($f) ; # get stat open (TMP,">".$t) || die "Can't open temporary file $t" ; open (MOD,$m) || die "Can't open META file $m\n"; while () { if (/http-equiv\s*=\W*PICS-Label/i) { $mpics++ ; } } close (MOD) ; if (!$mpics && !$force) { print "ERROR - the file $m does not appear to contain a PICS label\n"; exit ; } open (MOD,$m) || die "Can't open META file $m\n"; $del = 0 ; while () { if (m%%i) { $head++ ; } if (/http-equiv\s*=\W*PICS-Label/i) { $pics= $_ ; if (!$head) { print "Warning - Existing PICS tag before \n"; } if ($arg eq "-r" || $arg eq "-R") { # set delete flag $del=1 ; print "Deleting existing PICs tag $_\n"; } } if (m%%i) { $l1 = $_ ; $l2 = $_ ; $l1 =~ s%.*%%i ; # before /head $l2 =~ s%.*%%i ; # after /head if ($l1) {print TMP "$l1"; } while () { print TMP "$_" ; } print TMP "" ; if ($l2) {print TMP "$l2"; } $end++ ; if ($del) { $err++ ; print "ERROR - found inside PICS header\n"; } } else { if (!$del) {print TMP "$_" ; } } if (/\)\s*\)\s*'\s*>/) { $del = 0 ; } } if (!$end) { $err++ ; print "ERROR - No found in $f\n"; } if (!$head) { $err++ ; print "ERROR - No found in $f\n"; } if ($pics) { print "An existing PICS header was found in $f\n"; } close (FILE) ; close (TMP) ; close (MOD) ; if ($err) { exit ; } system("mv $t $f") && die "Can't mv $t to $f" ; # $fstat[x] 2 mode, 4 uid 5 gid 7 size 8 atime 9 mtime 10 ctime chmod($fstat[2],$f) || die "Can't change mode to $fstat[2] for $f" ; chown($fstat[4],$fstat[5],$f) || die "Can't change UID, GID to $fstat[4],$fstat[5] for $f" ; utime($fstat[8],$fstat[9],$f) || die "Can't change atime,mtime for $f"; print "Updated file $f\n"; unlink($t) ; sub promptuser { ($promptstring, $defval) = @_; print "$promptstring ($defval) :"; $useranswer = ; chop $useranswer; if ($useranswer =~ /^$/) { return $defval; } else { return $useranswer; } }