replace01.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:54 2010 from replace01.pl 2007/07/30 6 KB.

#!/perl -w
# NAME: replace01.pl
# AIM: To 'replace' a block of text after finding where, in a set of HTML files
# 30/07/2007 geoff mclane - http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $outfile = 'temp.'.$0.'.txt';
if ($0 =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$0);
   $outfile = 'temp.'.($tmpsp[-1]).'.txt';
}
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );
my $in_folder = "C:/HOMEPAGE/HOM/test4";
my @html_ext = qw( .htm .html .shtml .php );
my $out_folder = 'temp';
# debug
my $dbg1 = 0;
my @remove1 = ('<a href="product-lines.htm"', 'title="HOMMAGE product lines">product-lines</a>' );
my @replace1 = ('<a href="future-products.htm"', 'title="HOMMAGE future products">future-products</a>' );
my @remove2 = ('<a href="corporate_info.htm"', 'title="Corporate Information">corporate info</a>' );
my @replace2 = ();
# program variables
my @in_files = ();
my $fcnt = 0;
my $file = '';
my @warnings = ();
get_in_files( $in_folder );
$fcnt = scalar @in_files;
prt( "Got $fcnt input files ...\n" );
foreach $file (@in_files) {
   process_file($file);
}
if (@warnings) {
   prt( "\nRe-display of ".scalar @warnings." WARNING messages ...\n" );
   foreach $file (@warnings) {
      prt( "$file\n" );
   }
}
close_log($outfile,1);
exit(0);
############################################
### subs
sub process_file {
   my ($fil) = shift;
   my ($HF, $bgn, $end, $lcnt, $i, $ln, $tln, $fnd, $j, $rcnt, $msg, $k, $sp);
   $bgn = 0;
   $end = 0;
   $lcnt = 0;
   $fnd = 0;
   $rcnt = 0;
   $msg = '';
   my ($nm,$dir) = fileparse( $fil );
   if (open $HF, "<$fil") {
      my @lines = <$HF>;
      close $HF;
      $lcnt = scalar @lines;
      prt( "\nProcessing $nm ...$lcnt lines ...\n" );
      for ($i = 0; $i < $lcnt; $i++) {
         $ln = $lines[$i];
         chomp $ln;
         $tln = trim_all($ln);
         if ($tln =~ /<li>/i ) {
            $bgn = $i;
            $fnd = 1;
         } elsif ($tln =~ /<\/li>/i) {
            $end = $i;
            $fnd++;
         }
         if ($fnd == 2) {
            # we have a begin and end
            if ($end > $bgn) {
               ###prt( "Got $bgn to $end ...\n" );
               if (is_remove1( $bgn, $end, @lines )) {
                  prt( "Is remove/replace 1 ...\n" );
                  $k = 0;
                  for ($j = ($bgn + 1); $j < $end; $j++) {
                     $ln = $lines[$j];
                     $sp = '';
                     while (substr($ln,0,1) =~ /\s/) {
                        $ln = substr($ln,1);
                        $sp .= ' ';
                     }
                     $sp .= $replace1[$k];
                     $sp .= "\n";
                     $lines[$j] = $sp;
                     $k++;
                  }
                  $rcnt++;
               } elsif (is_remove2( $bgn, $end, @lines )) {
                  prt( "Is remove/replace 2 ...\n" );
                  for ($j = $bgn; $j <= $end; $j++) {
                     $lines[$j] = "\n";
                  }
                  $rcnt++;
               }
            } else {
               $msg = "WARNING: Found, but $end is lt or eq $bgn in [%nm]...";
               prt( "$msg\n" );
               push(@warnings,$msg);
            }
            $fnd = 0;
         }
      }
      if ($rcnt) {
         $msg = "Found $rcnt remove lines [$nm] ...";
         if ($rcnt == 2) {
            $msg .= ' ok';
         } else {
            $msg .= ' CHECKME';
         }
         my $of = $out_folder.'/'.$nm;
         write2file( join('', @lines), $of );
         $msg .= " written to [$of] ...";
         prt( "$msg\n" );
      } else {
         $msg = "WARNING: Remove lines NOT found in [$nm] *** WARNING ***...";
         prt( "$msg\n" );
         push(@warnings,$msg);
      }
   } else {
      $msg = "WARNING: Failed to open [$fil] ...";
      prt( "$msg\n" );
      push(@warnings,$msg);
   }
}
sub is_remove1 {
   my ($b, $e, @lns) = @_;
   my $fln = '';
   if ($e > $b) {
      my $ln = '';
      my $tln = '';
      my $cln = '';
      my $max = scalar @remove1;
      my $k = 0;
      for (my $j = ($b + 1); $j < $e; $j++) {
         $ln = $lns[$j];
         $tln = trim_all($ln);
         $k = $j - ($b + 1);
         $fln .= ' ' if (length($fln));
         $fln .= $tln;
         if ($k < $max) {
            $cln = $remove1[$k];
            if ($tln ne $cln) {
               return 0;
            }
         } else {
            return 0;
         }
      }
   } else {
      return 0;
   }
   prt( "Found $fln ...\n" );
   return 1;
}
sub is_remove2 {
   my ($b, $e, @lns) = @_;
   my $fln = '';
   if ($e > $b) {
      my $ln = '';
      my $tln = '';
      my $cln = '';
      my $max = scalar @remove2;
      my $k = 0;
      for (my $j = ($b + 1); $j < $e; $j++) {
         $ln = $lns[$j];
         $tln = trim_all($ln);
         $k = $j - ($b + 1);
         $fln .= ' ' if (length($fln));
         $fln .= $tln;
         if ($k < $max) {
            $cln = $remove2[$k];
            if ($tln ne $cln) {
               return 0;
            }
         } else {
            return 0;
         }
      }
   } else {
      return 0;
   }
   prt( "Found $fln ...\n" );
   return 1;
}
sub get_in_files {
   my ($inf) = shift;
   my $fcnt = 0;
   prt( "Processing $inf folder ...\n" ) if ($dbg1);
   if ( opendir( DIR, $inf ) ) {
      my @files = readdir(DIR);
      closedir DIR;
      foreach my $fil (@files) {
         if (($fil eq ".")||($fil eq "..")) {
            next;
         }
         my $ff = $inf."/".$fil;
         if ( -d $ff ) {
            # do nothing with this
         } else {
            if (is_my_ext($fil, @html_ext) ) {
               push(@in_files, $ff);
            } else {
               prt( "Discarding [$fil] ...\n" ) if (!is_known_ext($fil));
            }
         }
      }
   }
}
#########################################################
# Passed an array of extensions,
# check if this is one of them?
#########################################################
sub is_my_ext {
   my ($fil, @exts) = @_;
   my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ );
   foreach my $ex (@exts) {
      if (lc($ex) eq lc($ext)) {
         return 1;
      }
   }
   return 0;
}
sub is_js_ext {
   my ($fil) = shift;
   my @js_ext = qw( .js );
   return is_my_ext($fil, @js_ext);
}
sub is_css_ext {
   my ($fil) = shift;
   my @css_ext = qw( .css );
   return is_my_ext($fil, @css_ext);
}
sub is_swf_ext {
   my ($fil) = shift;
   my @swf_ext = qw( .swf );
   return is_my_ext($fil, @swf_ext);
}
sub is_ico_ext {
   my ($fil) = shift;
   my @swf_ext = qw( .ico );
   return is_my_ext($fil, @swf_ext);
}
sub is_known_ext {
   my ($fil) = shift;
   if (is_js_ext($fil) ||
      is_css_ext($fil)||
      is_swf_ext($fil)||
      is_ico_ext($fil)) {
      return 1;
   }
   return 0;
}
# eof - replace01.pl

index -|- top