#!/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
