#!/usr/bin/perl
# Perl script for removing Java scripts from HTML files
# Created:
$VERSION = '(C) eko@lanet.lv 2017/08/02 08:27';
# Author: Kārlis Kalviškis <eko@lanet.lv>
# License: GPLv3


# For translation
use Locale::gettext;
use POSIX; 
setlocale(LC_MESSAGES, "");
my $tulkojums =   Locale::gettext->domain_raw('karlo-scripts');

print "\n" . $tulkojums->get('Perl script for removing Java scripts from HTML files') . ".\n   $VERSION\n";


use Encode;

# Default variables  ########################################################
#                                                                           #
# File extensions (the case does not matter)                                #
@koMeklet = ('htm','html','shtml','asp');                                   #
#                                                                           #
# Strings to be searched ('vecais') (regex sintax)                          #
# Strings to be as the replacement ('jaunais')                              #
$nomaina{0}{'vecais'} =  '<script.*?script>';                               #
$nomaina{0}{'jaunais'} =  '';                                               #
$nomaina{1}{'vecais'} =  '(<[^<]*)\b\w*=\"javascript[^\"]*\"';              #
$nomaina{1}{'jaunais'} =  '$1';                                             #
$nomaina{2}{'vecais'} =  '(<[^<]*)\bonclick=\"[^\"]*\"';                    #
$nomaina{2}{'jaunais'} =  '$1';                                             #
$nomaina{3}{'vecais'} =  '(<[^<]*)\onmouseout=\"[^\"]*\"';                  #
$nomaina{3}{'jaunais'} =  '$1';                                             #
$nomaina{4}{'vecais'} =  '(<[^<]*)\bonmouseover=\"[^\"]*\"';                #
$nomaina{4}{'jaunais'} =  '$1';                                             #
$nomaina{5}{'vecais'} =  '(<[^<]*)\bquerystr=\"[^\"]*\"';                   #
$nomaina{5}{'jaunais'} =  '$1';                                             #
$nomaina{6}{'vecais'} =  '(<[^<]*)\bonload=\"[^\"]*\"';                     #
$nomaina{6}{'jaunais'} =  '$1';                                             #
$nomaina{7}{'vecais'} =  '<\/?noscript[^>]*>';                              #
$nomaina{7}{'jaunais'} =  '';                                               #
#                                                                           #
#############################################################################

# Commandline parameters (if any))
$drukaat = 1;
foreach (@ARGV){
	if ($_ eq '-R') {
		$visas_dir = 1 ;
	}
	elsif ($_ eq '-J') {
		$neko_nejautaat = 1 ;
	}
	elsif ($_ eq '-D') {
		$dzees_failus = 1 ;
	}
	elsif ($_ eq '-m') {
		$drukaat = 0 ;
	}
	elsif ($_ eq '-h' || $_ eq '-help' || $_ eq '--help'){
		&paskaidro;
	}
	elsif (/^-pap=/){
		@koMeklet = split /,/, substr ($_,5);
	}
	else {
		push (@failu_saraksts, $_);
	}
}

# Counter of processed files 
$apstraadaati_faili = 0;

# Base directory
$vieta = './';

if (!$neko_nejautaat && !@failu_saraksts) {
	print $tulkojums->get('Explanation') . ": $0 -h \n";
	print "\n" . $tulkojums->get('Base directory') . ": '$vieta'.\n";
	print $tulkojums->get('The directories will be processed recursively') . ".\n" if $visas_dir;
	print $tulkojums->get('The connected script files will be deleted') . ".\n" if $dzees_failus;
	print $tulkojums->get('The files will be overwritten') . "!\n";
	print $tulkojums->get('The files to be processed') . ": @koMeklet\n";
	print $tulkojums->get('String to be searched for') . ' ->->-> ' . $tulkojums->get('replacement') . ":\n\n";
	@atsauces = keys(%nomaina);
	foreach (@atsauces) {
	print "$nomaina{$_}{'vecais'} ->->-> $nomaina{$_}{'jaunais'}\n";
	}
	print "\n\n" . $tulkojums->get('Process the files? (Y/N)') . "\n\n";

	# Continue?
	while ($atbilde ne "J" && $atbilde ne "Y"){
		chomp ($atbilde = <STDIN>);
		$atbilde = uc($atbilde);
		if ($atbilde eq "N") {
			exit;
		}
	}
}

if (@failu_saraksts) {
	foreach (@failu_saraksts) {
		&aizstaaj ($vieta, $_);
	}
}
else {
	&sameklee_failus($vieta);
}
print "\n\n"  if $drukaat;
print $tulkojums->get('The processed files') . ": $apstraadaati_faili \n";
print "\n\n"  if $drukaat;
exit;

#############################################################################


# Recursively search files.
#   $direktorija – directory name.
sub sameklee_failus {
	my($direktorija) = @_;
	my(@failu_saraksts);
	print $tulkojums->get('Processing') . " $direktorija\n" if $drukaat;
	if (!opendir(DIREKTORIJA_NR, $direktorija)) {
		print $tulkojums->get('Access denied') . ": $direktorija\n" if $drukaat;
		return;
	}
	@failu_saraksts = readdir(DIREKTORIJA_NR);
	close(DIREKTORIJA_NR);
	foreach (@failu_saraksts) {
		if (/^\./) {
			next;
		}	

		# Only normal files are processed
		if (-f $direktorija . $_){
			foreach $t_pap (@koMeklet) {
				if (/$t_pap$/i) {
					&aizstaaj ($direktorija, $_);
					last;
				}
			}
		}

		# Looks for subdirectories
		elsif (-d _){
			if ($visas_dir) {
				$drk = $direktorija . $_ . "/";
				&sameklee_failus($drk);
			}
		}
	}
}

# Actual replacement
#   $direktorija – directory;
#   $kuru – file.
sub aizstaaj {
	my ($direktorija, $kuru) = @_;
	if (open FAILS, "<$direktorija$kuru") {
		my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat(FAILS);
		read FAILS, $teksts, $size;
		close FAILS;
		if (open(JAUNAIS, ">$direktorija$kuru")) {
			$apstraadaati_faili += 1;
			if ($dzees_failus) {
				foreach my $ir_fails ($teksts =~ /<script[^>]*src="([^"]*)"[^>]*>/gims) {
					unlink $direktorija . $ir_fails;
 					print $tulkojums->get('Is going to be deleted') .": $ir_fails\n" if $drukaat;
				}
			}
			@apmainamie = keys %nomaina;
			$_ = $teksts;
			foreach $vards (@apmainamie){
				$vecais_teksts = $nomaina{$vards}{'vecais'};
				$jaunais_teksts = $nomaina{$vards}{'jaunais'};
				eval "s/$vecais_teksts/$jaunais_teksts/gims";
			}
			print JAUNAIS $_;

			# Looking for iframes
			my $direktorija2, $fails2;
			while (/<[^>]*iframe[^>]*src="([^">]+)"[^>]*/gi) {
				$fails2 = $1;
				if ($1 =~ /(.*\/)([^\/]+)/){
					$direktorija2 = $direktorija . $1;
					$fails2 = $2;
				}
				else {
					$direktorija2 = $direktorija;
				}
				print "Atrasts rāmis: $direktorija2 $fails2\n" if $drukaat;
				&aizstaaj ($direktorija2, $fails2);
			}
		}
		else {
			print $tulkojums->get('Access denied') . " $direktorija$_ \n" if $drukaat; 
		}
	}
	else {
		print $tulkojums->get('Access denied') . " $direktorija$_ \n" if $drukaat; 
	}
}

# Replace HEX simbols
sub noHEX {
	my $teksts = shift;
	$teksts =~ s/%([0-9A-Fa-f]{2})/\\x$1/g;
	return  decode_utf8($teksts);
}

# Help message
sub paskaidro {
	print "\n" . '-' x 60  . "\n" .
		'   ' . $tulkojums->get('The files will be overwritten') . "!\n" .
		'-' x 60 . "\n" .
		"$0  [" . $tulkojums->get('Options') . '] [' . $tulkojums->get('File') . '1] [' . $tulkojums->get('File') . "2] [...]\n" .
		' ' x 6 . $tulkojums->get('Options') . ":\n" .
		' ' x 9 . '-D	' . $tulkojums->get('Delete connected script files') . ";\n" .
		' ' x 9 . '-h	' . $tulkojums->get('This help message') . ";\n" .
		' ' x 9 . '-J	' . $tulkojums->get('No questions') . ";\n" .
		' ' x 9 . '-m	' . $tulkojums->get('Only the count of processed files is displayed') . ";\n" .
		' ' x 9 . '-R	' . $tulkojums->get('The directories will be processed recursively') . ";\n" .
		' ' x 9 . '-pap=ARG1[,ARG2[,...]]	 ' . $tulkojums->get('Different file extensions') . ".\n" .
		'-' x 60 . "\n";
	exit;
}
