# bullfix - append a copyright notice
# for Bernard Nivelet
#
# perl bullfix.pl lddcopy table directories >result.txt (or result.csv for Excel)
#
# Directories is 0 to output all files and 1 to output directories only
#
# reads a file containing lines of the form
#   .pl1,C:\ABC\DEF\PL1.TXT
#
# each of these .TXT files contains a different copyright
# notice formatted as a comment in the appropriate language
#
# processes all files inferior to the directory lddcopy
# prints a line for each file processed
#
# should work for Mac/Windows/Unix
#
# THVV 08/29/05 1.0    initial code
# THVV 08/30/05 1.1    Changes per Bernard, handle archives, improve dbcs 
# THVV 09/09/05 1.2    Fix bug in archive
# THVV 09/10/05 1.3    Fix bug in suffix counts, handle _instructions
# THVV 09/10/05 1.4    Fix bug  _instructions
# THVV 10/18/05 1.5    Changes per Bernard, handle more file types
# THVV 10/19/05 1.6    fix reporting of counts, add dontsuffix
# THVV 10/28/05 1.7    change message columns per Bernard
# BN     11/01/05 1.7.1 change message columns using CSV
# BN     11/02/05 1.7.2 Test the files for binary (i.e. non ASCII character in the 300 last bytes) before searching suffix in table
# THVV 10/28/05 1.7.3 Small cleanups.
# BN     11/03/05 1.7.4 Set .9 as binary and .s.archive as non binary (because they end with 0x00
# BN     11/04/05 1.7.5 Set .s.archive.1 as .s.archive and add a "," before ($printablesuffix) in $whatfile to improve legibility
# THVV 11/04/05 1.7.6 Bernard reports that we add the prefix every time to a .s.archive or .archive file.  Try to fix.
# BN     11/06/05 1.7.7 Fix the precedent problem: error in using vec(.)=0x0A and not 10, and so on ...
#		      In s.archive files, replace ending 0x00 i $content before binary testing by CRLF to avoid damaging file
# BN     11/06/05 1.8    Fixes in 1.7.4, 1.7.5 and 1.7.7 ... 1.8 processes correctly the .s.archives files
# BN     11/06/05 1.8.1 Identification of text and binaries in the output ( Txt for text files and empty for binaries )Takes care of .s.archive text files in test for binary ending: they could end by up to 3 0x0
#		      Takes care properly of .9 files (create $endingsuffix)
#		       Relocate "double byte encoded" test in front
#		      Add escape as binary if more than 10% binary characters found 
#		      Add test to two adjacent binary bytes
#		      Apply ASCII testing to the beginning (300 first bytes) of .archive files because they end frequently with long ASCII sequences
#			If the beginning is ASCII, then test the end
#		      Add looking for .s.archive.1 and .s.archive.2 as .s.archive
#		      Add looking for "THIS FILE IS DAMAGED", messages I add by hand to text damaged files (essentialy .list files)
# BN     11/26/05  1.9  Relocate "double byte encoded" test in case $note is empty
#		     Change looking for "THIS FILE IS DAMAGED" message already set in front of file
#		     Look at "damaged" directories
#		     Change testing for binary:  beginning and end of file; if yes in either cases, then binary.
#		    	Else, if beginning binary or end binary, then damaged
#		     Create $fullcontent to add $damnote in front of $content when file identified as damaged
# BN     11/28/05  2.0  Remove sort in chkdir to keep the order of directories and processing of their files
#		     Make &fixpage a function returning the size of the file
#		     Create the array $statistics in program for chkdir to keep number of files in the directory, 
#			cumulated number of files in the root, cumulated size of files in the directory, 
#			cumulated size of files in the root
# BN     12/07/05  2.1  Add tabulation for listing of files in fixpage
#		     Add printing of number of files in directory and number of bytes in directory
# BN     12/08/05  2.2  Reorganize fixpage to avoid systematic scanning of files (do it only if notice found)
#		     Change ASCII testing from 300 first bytes to all file, but introduce 10% of binary bytes 
#			to declare file binary
# BN     12/09/05  2.3  Automatic creation of "damaged" sub-directories including damaged files when found
# BN     12/15/05  2.4  Automatic creation of "binaries" sub-directories including binary files when found
# BN      1/19/06  2.5  Add in main program a print of $root before calling checkdir and of <TD> $root after,
#		        in order to deliver result.csv file right for bullform processing
# BN      1/23/06  2.6  Add checking for ASCII of files without known notice; if so, put them in 'no_notice' sub_directory 
#			to update table later
# BN      2/16/06  2.7  Add blank notice to .html files to avoid creation of no_notice sub_directory for them
#		    Print file line on two lines when filename two long
# BN      5/14/06  3.0 Identify files as multisegment when ASCII and no notice in TABLE and name is 0 to 4;
#		    No action in this case

$now_string = localtime();
print "$now_string\n";

$version = "3.0";
print "bullfix $version\n";

#die "perl bullfix.pl directories lddcopy table" if $#ARGV != 1;

$root = shift;		# root directory to process
$tables = shift;	# root directory containing tables (table of files types and type dependant notices)
$directories = shift;

	if( $directories == 0){
		print "\nFull edition of directories and files \n\n";
	}else{
		$directories=1;
		print "\nEdition limited to the directories\n\n";
	}

# check that $root is a dir
die "$root not a directory" if !-d $root;

# read the table
$nsuf = 0;
open(TXT, "$tables/table.txt") || die "$table not found $!";
while (<TXT>) {
    chomp;
    if (/^\.(.*),(.*)$/) {	# match input line against dot (aything) comma (anything)
	$suffix = $1;		# suffix without dot
	$suffile = $2;		# file path
	if ($suffile eq 'dontsuffix') {
	    $notices{$suffix} = 'dontsuffix';
	} else {
	    $cont = '';
	    open(FIL, "$tables/$suffile") || die "$suffile not found $!";
	    binmode FIL;	# for Windows, read notice as bytes.
	    while (<FIL>) {
		$cont .= $_;
	    }
	    close FIL;
	    $notices{$suffix} = $cont; # save the notice
	}
	$uses{$suffix} = 0;
	$nsuf++;
    } else {
	die "illegal format: $_"; # can't parse line
    }
} # while
close TXT;
die "no suffixes" if $nsuf == 0;

# globals
$sufbad = 0;
$sufadd = 0;
$sufwas = 0;
$sufdbe = 0;
$sufbin = 0;

# walk the tree
my @statistics=(0,0,0,0,0,0,0,0,0,0,  0,0,0,0,0,0,0,0,0,0, 0,0);	# file_count from 0 to 9, byte_count from 10 to 19,
							# 20 total file count, 21 total byte count
my @commas=("" , "," , ",," , ",,," , ",,,," , ",,,,," , ",,,,,," , ",,,,,,," , ",,,,,,,,");

print "\n","Names of files and directories",",,,,,,,,","Type,Number of bytes in file,Number of bytes in directory,";
print "Number of files in directory,Number of bytes in binaries directory,Number of files in binaries directory,";
print "Number of bytes in damaged directory,Number of files in damaged directory,";
print "Number of bytes in no notice directory,Number of files in no notice directory\n\n";

		print "\n",$commas[0],$root,$commas[8],"<Directory>\n";
&checkdir($root, 1,$statistics,$commas,$directories);
 		print "<TD> ",$root,",,,,,,,,,,",$statistics[10],",",$statistics[0],"\n";
print "\n,,,,,,,,Total byte count,$statistics[21]\n,,,,,,,,,,Total file count,$statistics[20]\n\n";

exit(0);	# cancel this if statistics on suffixes are not required

# print totals
print "unknown suffix: $sufbad\n";
print "double byte:    $sufdbe\n";
print "binary:         $sufbin\n";
print "suffix already: $sufwas\n";
print "dontsuffix:     $dnsuff\n";
print "suffixes added: $sufadd\n";
foreach $key (keys %uses) {
    print "                $key  $uses{$key}\n";
}
exit(0);

# ================================================================
# recursive routine to process directories
# &checkdir($dirname, $level, $statistics,$commas,$directories);
# ignores files beginning with dot
sub checkdir {
    my $dir = shift;
    my $lev = shift;
    my $statistics=shift;
    my $commas=shift;
    my $directories=shift;

    my $f;
    my $file_count;
    my $byte_count;
    my $col_fixpaj=0;
    my $dam_dir_created_or_modified=0;
    my $dir_dam="$dir/damaged";
    my $bin_dir_created_or_modified=0;
    my $dir_bin="$dir/binaries";
    my $no_notice_dir_created_or_modified=0;
    my $dir_no_notice="$dir/no_notice";
#print $dir_dam,"\n";

    opendir(DH, "$dir");
#    my(@allfiles) = sort grep !/^\./, readdir DH;
    my(@allfiles) = grep !/^\./, readdir DH;;	# sorting cancelled because it creates intertwining of files and directories depending of their global lexical order
    closedir DH;

    $file_count=0;
    $byte_count=0;

    foreach $f (@allfiles) {
	# if it's a file
	if (-f "$dir/$f") {
		$col_fixpaj=&fixpage($dir,$f, $lev,$commas,$directories);
		if( $col_fixpaj >= 0 ){
			$file_count++;
			$byte_count+=$col_fixpaj;
		}elsif ( $col_fixpaj>-3) {
			$dam_dir_created_or_modified = 1;
		}elsif ( $col_fixpaj>-5) {
			$bin_dir_created_or_modified = 1;
		}else{
			$no_notice_dir_created_or_modified = 1;
		}
	} elsif (-d "$dir/$f") {
		print "\n",$commas[$lev],"$dir/$f",$commas[8-$lev],"<Directory>\n";
		&checkdir("$dir/$f", $lev+1,$statistics,$commas,$directories);
 		print "<TD> ","$dir/$f",",,,,,,,,,,$statistics[$lev+10+1],$statistics[$lev+1]";
		if( index("$dir/$f","binaries") >= 0 ){
			print ",$statistics[$lev+10+1],$statistics[$lev+1]";
		}elsif( index("$dir/$f","damaged") >= 0 ){
			print ",,,$statistics[$lev+10+1],$statistics[$lev+1]";
		}elsif( index("$dir/$f","no_notice") >= 0 ){
			print ",,,,,$statistics[$lev+10+1],$statistics[$lev+1]";
		}
		print "\n";
	} else {
	    # not file, not dir, ignore
	}
    } # foreach

    if ($bin_dir_created_or_modified == 1) {
	print "\n",$commas[$lev],"$dir_bin/$f",$commas[8-$lev],"<Directory>\n";
	&checkdir($dir_bin, $lev+1,$statistics,$commas,$directories);
 	print "<TD> ","$dir_bin,,,,,,,,,,$statistics[$lev+10+1],$statistics[$lev+1],$statistics[$lev+10+1],$statistics[$lev+1]\n";
    }
    if ($dam_dir_created_or_modified == 1) {
	print "\n",$commas[$lev],"$dir_dam/$f",$commas[8-$lev],"<Directory>\n";
	&checkdir($dir_dam, $lev+1,$statistics,$commas,$directories);
 	print "<TD> ","$dir_dam,,,,,,,,,,$statistics[$lev+10+1],$statistics[$lev+1],,,$statistics[$lev+10+1],$statistics[$lev+1]\n";
    }
    if ($no_notice_dir_created_or_modified == 1) {
	print "\n",$commas[$lev],"$dir_no_notice/$f",$commas[8-$lev],"<Directory>\n";
	&checkdir($dir_no_notice, $lev+1,$statistics,$commas,$directories);
 	print "<TD> ","$dir_no_notice,,,,,,,,,,$statistics[$lev+10+1],$statistics[$lev+1],,,,,$statistics[$lev+10+1],$statistics[$lev+1]\n";
    }
    $statistics[$lev]=$file_count;
    $statistics[$lev+10]=$byte_count;
    $statistics[20]+=$file_count;
    $statistics[21]+=$byte_count;
    return  $statistics;
} # checkdir

# ================================================================
# called once per file
# &fixpage($directory,$filename, $level,$commas,$directories);
# uses global: %notices $sufbad $subadd $sufwas $sufdbe
sub fixpage {
    my $directory = shift;
    my $filename = shift;
    my $depth = shift;
    my $commas=shift;
    my $directories=shift;

    my $actiontaken;		# comment result
    my $altsuffix = '';
    my $base_ASCII = 8;		# TAB - lowest legal ASCII
    my $bin_prop=10;		# escape as damaged less than $bin_prop% binary characters found in an ASCII file (with nortice) , and binary if more than that :
				# 10% and no more because of tables for special characters
    my $BYTESIZE = 8;		# 8 bit bytes
    my $char=0;
    my $content = '';
    my $create_bin_file=0;
    my $create_dam_file=0;
    my $create_note_file=0;
    my $dam_note="THIS FILE IS DAMAGED

";
    my $dir_bin=0;
    my $dir_bin_name="$directory/binaries";
    my $dir_dam_name="$directory/damaged"; 
    my $dir_no_notice_name="$directory/no_notice";
    my $endingsuffix;
    my $fullcontent;
    my $i = 0;
    my $max_ASCII = 127;		# highest legal ASCII
    my $nb_bin=0;			# Binary characters meter
    my $note = '';
    my $suffix = '';
    my $type=",Txt";

    # extract the suffix from the file name
    my $x = index($filename, '.'); # find first dot
    if ($x > 0) {
	$suffix = substr($filename, $x+1); # suffix without dot
	if ($suffix =~ /^.*\.(.*)$/) {
	    $altsuffix = $1; # if suffix was "gi.info" => "info"
	    $endingsuffix=$altsuffix;
	}else{
	    $endingsuffix=$suffix;
	}
    }
    if ($suffix eq "") {	# try underscore
	if ($filename =~ /_(.*)$/) {
	    $suffix = "_$1";
	}
    }				# try underscore
    if ($suffix eq "") {
 	$suffix = "source" if index ($directory, "\\source\\") > -1;
 	$suffix = "source" if index ($directory, "/source/") > -1;
     }

    my $printablesuffix = $suffix;
    $printablesuffix .= '|' . $altsuffix if $altsuffix ne '';

    # read in whole file
    open(IF, "$directory/$filename") || die "can't read $directory/$filename";
    binmode IF;			# For Windows, read file as bytes.
    while (<IF>) {
	$content .= $_;
    }
    close(IF);

   my $sl = length($content);
   my $max_bin=$sl*($bin_prop/100);

    if (index($directory,"binaries") >= 0 ){
	$dir_bin=1;
    }

   if( ($suffix eq "jpeg") || ($suffix eq "gif") || ($suffix eq "doc") || ($suffix eq "xls") || ($suffix eq "rtf") || ($suffix eq "pl") || ($suffix eq "bat") || ($suffix eq "html") || ($filename eq "table.txt") ){
				# exhibit files: nothing to do
	$type="";
	$actiontaken = "";
    }elsif ( $dir_bin == 1 ){
	$type=",";
	$actiontaken = ",binary file,,,,,,";
    }elsif ( index($directory,"damaged") >= 0 ){
	$type=",!! Txt damaged !!";
	$actiontaken = ",,,,,notice already present,,";
    }elsif ( index($directory,"no_notice") >= 0 ){ # notice unknown already processed; just to be printed
	$actiontaken = ",,,,,,no notice for \"$printablesuffix\",,,,"; 
    }elsif ( ($endingsuffix eq "9") || ($sl==0) ){
	if ( $dir_bin == 1 ){
		$type=",";
		$actiontaken = ",binary file,,,,,,";
	}else{
		$create_bin_file = 1;
	}
    }elsif ( index($content, "Copyright 2006 by Bull HN Information Systems Inc.") >= 0 ){
	$type=",";
	$actiontaken = ",,,,,notice already present,,";

    } else {					# get the notice for this suffix
	if ($notices{$filename} ne '') {
		$note = $notices{$filename};
		$suffixused = $filename;
	} elsif ($notices{$suffix} ne '') {
		$note = $notices{$suffix};
		$suffixused = $suffix;
	} elsif ($notices{$altsuffix} ne '') {
		$note = $notices{$altsuffix};
		$suffixused = $altsuffix;
	}

	if ($note eq '') {			# if not suffix
		while ( ($i < $sl) && ($nb_bin <= $max_bin) ) {	# Scan upwards from beginning for binaries.
	  		$char = vec($content, $i, $BYTESIZE);
	  		if (($char > $max_ASCII) || ($char < $base_ASCII)) { # non ASCII character found
				$nb_bin++;
			}
			$i++;
		} # while -  end check file for ASCII
		if( $nb_bin == 0 ){			# No notice and File is ASCII
			if( ($filename ne "0") and  ($filename ne "1") and ($filename ne "2") and ($filename ne "3") and ($filename ne "4") ){
						# not a multisegment file: put file in a "no notice" sub-directory
				$create_note_file=1;			
				if( !opendir( DIR, $dir_no_notice_name) ){
					mkdir($dir_no_notice_name);
					$sl=-6;
				}else{
					$sl=-5;
				}			
				open(OF, ">$dir_no_notice_name/$filename") || die "can't write $dir_no_notice_name/$filename";
				binmode OF;	# For Windows, write file as bytes.
				print OF $content;
				close(OF);
				closedir(DIR);
				unlink "$directory/$filename";
			}
		}elsif( $nb_bin >= $max_bin ){	# the file is considered as binary
			$create_bin_file = 1;
		}else{
			$create_dam_file=1;	# the file is considered as damaged
		}

	}elsif ($note eq 'dontsuffix') {
		$actiontaken = ",,,,,,dontsuffix for \"$printablesuffix\",";	# OK but say so
    	}elsif ( (($filename eq "test")&&(index($directory,"ldd/bos/object")>=0)) || (($filename eq "mexp")&&(index($directory,"tools")>=0)) ){
		$create_bin_file = 1;
			# Special case: ASCII files in doc having those names of binary files

	}else{						# suffix
		$uses{$suffixused}++;
		# see if notice is already added
		if (index($content, $note) >= 0) { 	# if present
			$actiontaken = ",,,,,notice already present,,";
		} else {		     # not present

			if ( $altsuffix eq "archive" ){	#  replace ending 0x00 by CRLF in order to avoid binary inside a text file
				vec($content, $sl-1, $BYTESIZE) = 0x0D;	# last character in $content set to charriage return
				$char=vec($content, $sl-2, $BYTESIZE);
				if($char == 0 ){					# before last character of $content is 0x'00'
					vec($content, $sl-2, $BYTESIZE) = 0x0A;	# set it to line feed
					$char=vec($content, $sl-3, $BYTESIZE);
					if($char == 0 ){					# before before last character of $content is 0x'00'
						vec($content, $sl-3, $BYTESIZE) = 0x0A;	#  set it to line feed
					}      						# before before last character
				}						# before last character
			}	# archive

			# check file for ASCII: as suffix means text file, non ASCII character would characterize
			# damaged files
			$i=0;
			$nb_bin=0;
			while ( ($i < $sl) && ($nb_bin <= $max_bin) ) {	# Scan upwards from beginning.
	  			$char = vec($content, $i, $BYTESIZE);
	  			if (($char > $max_ASCII) || ($char < $base_ASCII)) { # non ASCII character found
					$nb_bin++;
				}
				$i++;
			} # while -  end check file for ASCII
	
			if ( $nb_bin >= $max_bin )  {
				$create_dam_file=1;
			}else{
				$content.=$note; # append the notice
				$actiontaken = ",,,notice added,,,,";

				if ($suffix =~ /archive$/) { 	# archive headers are on word boundary
					# This archive padding thing is not going to work as expected because
					# .. the files have been worked over on a Windows system and the
					# .. line endings changed from LF to CRLF.  If a source archive is
					# .. brought back to a Unix or Mac and the CRLFs changed to LFs, the
					# .. padding may be wrong.  So what.
						my $npad = 4 - ($sl % 4); 			# number of chars to make mult of 4
					$content .= $npad x "\0" if $npad < 4;	# stick in 1-3 nulls	
# HAVE I TO ADD $npad TO $sl ?? IT SEEMS TO BE OK WITHOUT THAT...
				}
				$sl=length($content);

				if( ($create_bin_file == 0) && ($create_dam_file == 0) && ($create_not_file == 0) ){
		   			# rewrite the file
		   			open(OF, ">$directory/$filename") || die "can't write $directory/$filename";
		   				binmode OF;	# For Windows, write file as bytes.
		    				print OF $content;
		   			close(OF);
				}
			}
		} # not present
	} # suffix

	if( $create_dam_file == 1 ){
		my $fullcontent=$dam_note ;
    		if ( ($filename eq "mcs.s.archive")&&(index($directory,"ldd/355/source")>=0) ){
			$fullcontent .= "	SEE COMPANION Multics/ldd/mcs/source/mcs.s.archive

";
		}
    		if ( ($filename eq "ibm3270_tables.list")&&(index($directory,"ldd_listings/mcs")>=0) ){
			$fullcontent .= "	SEE COMPANION ldd_listings/355/ibm3270_tables.list

";
		}
    		if ( ($filename eq "dia_man.list")&&(index($directory,"ldd_listings/355")>=0) ){
			$fullcontent .= "	SEE COMPANION ldd_listings/mcs/dia_man.list

";
		}
		$fullcontent .= $content . $note;
		$sl=length($fullcontent);
		if( !opendir( DIR, $dir_dam_name) ){
			mkdir($dir_dam_name);
			$sl=-2;
		}else{
			$sl=-1;
		}			
	   	open(OF, ">$dir_dam_name/$filename") || die "can't write $dir_dam_name/$filename";
	   		binmode OF;	# For Windows, write file as bytes.
	    		print OF $fullcontent;
	   	close(OF);
		closedir(DIR);
		unlink "$directory/$filename";
	}
			
    } # get the notice for this suffix

    if ( $create_bin_file == 1 ) {
	if( !opendir( DIR, $dir_bin_name) ){
		mkdir($dir_bin_name);
		$sl=-4;
	}else{
		$sl=-3;
	}			
	open(OF, ">$dir_bin_name/$filename") || die "can't write $dir_bin_name/$filename";
		binmode OF;	# For Windows, write file as bytes.
		print OF $content;
	close(OF);
	closedir(DIR);
	unlink "$directory/$filename";
   }

    if( ( $directories==0 ) && ( $create_dam_file==0 ) && ( $create_note_file==0 ) && ( $create_bin_file==0 ) ){
	my $lf=length($filename);
	my $crlf="
";
	print $commas[$depth], $filename;
	if( $lf+$depth*3.285714 > 48){
		print $crlf, $commas[8];
	}else{
		print $commas[8-$depth];
	}
	print "<File>,",$sl,",,,,,,,,,", ($printablesuffix),  $type, $actiontaken,"\n";
    }

    return $sl;
} #fixpage

# ================================================================
# what an archive header looks like
# /* BEGIN INCLUDE FILE archive_header.incl.pl1 */
# dcl 1 archive_header aligned based, -- begins on word boundary
#     2 header_begin char (8), # 014012012012017012011011
#     2 pad1 char (4),         # 040040040040
#     2 name char (32),        # trailing blanks
#     2 timeup char (16),      # 11/30/82  1008.4
#     2 mode char (4),         # rew
#     2 time char (16),        # 11/30/82  1008.4
#     2 pad char (4),          # 040040040040
#     2 bit_count char (8),    #  will always be 0 mod 36
#     2 header_end char (8);   # 017017017017012012012012
# /* END INCLUDE archive_header.incl.pl1 */

# 10/28/05
# Could it be possible that bullfix print in different fixed columns the messages
# no notice
# notice added
# notice already present
# For instance
# column 75 for no notice
# column 80 for notice added
# column 85 for notice already present
# This would improve very much the readibility in the verification process
# Thanks a lot