#!/perl -w
# NAME: filelist.pl
# AIM: Write a complete list of files, recursively in a directory, to be used by say a zip
# utility. It excludes .svn, .git, and CVS directories from the list,
# and excludes such things as *.obj, etc
# 06/03/2016 - some UI enhancments 1 - no recursive search
# 2009/10/13  - geoff mclane - http://geoffair.net/mperl/
use strict;
use warnings;
use File::Basename;
use Cwd;
use File::stat;
unshift(@INC, 'C:\GTools\perl');
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
    my @tmpsp = split(/\\/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $perl_dir = 'C:\GTools\perl';
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# user variables
my $load_log = 0;
my $in_dir = '';
my $root_dir = '';
my $out_file = $perl_dir."\\templist.txt";
my $verbosity = 1;
my $recursive = 1;
my %exclude_dirs = (
    '.svn' => 1,
    'CVS' => 2,
    '.git' => 3
    );

my @excluded_exts = qw( .old .bak .obj .err .pdb .lst .pch .ilk .NCB .plg .OPT .idb 
.aps .sbr .suo .user .res .dep .exp .manifest .htm .lib .dll .exe .bsc .zip .gz .tar .bz2 );

my @include_exts = ();
my @exclude_files = ();

### debug
my $dbg01 = 0;  # show prt( "[dbg01] $pgmname: in [$cwd]: Hello, World...\n" ) if ($dbg01);
my $dbg02 = 0;  # prt( "[dbg02] Scanned $total_dirs directories, for $total_files files, ".get_size_msg($total_size)." bytes...\n" ) if ($dbg02);
my $dbg03 = 0;  # prt( "[dbg03] Out $cnt files, to [$out]...\n" ) if ($dbg03);
my $dbg04 = 0;  # prt( "[dbg04] Excluded $exclude files, $dexclude by directory, $eexclude by extension...\n" ) if ($exclude && $dbg04);

### program variables
my @warnings = ();
my $cwd = cwd();
# my $block_size = 0; # stat($cwd)->blksize; # fails in WIN32
my @file_list = (); # final file list
my $total_dirs = 0; # total direcotries scanned
my $total_files = 0;
my $total_size = 0;
my $os = $^O;

# forward references
sub scan_directory($$);

sub VERB1() { return ($verbosity > 0); }
sub VERB2() { return ($verbosity > 1); }
sub VERB3() { return ($verbosity > 2); }
sub VERB4() { return ($verbosity > 3); }
sub VERB5() { return ($verbosity > 4); }
sub VERB6() { return ($verbosity > 5); }
sub VERB7() { return ($verbosity > 6); }
sub VERB8() { return ($verbosity > 7); }
sub VERB9() { return ($verbosity > 8); }
sub VERB10() { return ($verbosity > 9); }
sub VERB11() { return ($verbosity > 10); }

sub list_exclude_ext() {
    my ($ext,$wrap);
    if (@excluded_exts) {
        $wrap = 0;
        prt( " Default file extensions excluded are (not case sensitive) :-\n " );
        foreach $ext (@excluded_exts) {
            prt( "$ext " );
            $wrap++;
            if ($wrap > 15) {
                prt("\n ");
                $wrap = 0;
            }
        }
        prt("\n") if ($wrap);
    }
}

sub give_help() {
    prt( "$pgmname [options] directory\n" );
    prt( "Options:\n" );
    prt( "  --help (-h or -?) = This help, and exit.\n" );
    prt( "  --out=<file> (-o) = Set the output file.\n" );
    prt( "  --dir=<dir>  (-d) = Set directory (alternative way).\n" );
    prt( "  --add=<ext>  (-a) = Add an excluded file extension.\n" );
    prt( "  --sub=<ext>  (-s) = Subtract (remove) and excluded file extension.\n" );
    list_exclude_ext();
    prt( "  --inc=<ext>  (-i) = Include this, these extensions.\n" );
    prt( " Note, if --inc:<ext> given, then ONLY these extensions are included.\n" );
    prt( "  --Remove     (-R) = Remove ALL excluded file extensions.\n" );
    prt( "  --resursive  (-r) = No recursive directory search.\n" );
    prt( "  --load       (-l) = Load log at end.\n" );
    prt( "  --verb       (-v) = Increase verbosity.\n" );
    ###prt( " Using current directory ($cwd), if no directory given.\n" );
}

sub show_warnings() {
   if (@warnings) {
      prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
      foreach my $itm (@warnings) {
         prt("$itm\n");
      }
      prt("\n");
   } else {
      prt( "No warnings issued.\n" ) if (VERB5());
   }
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    show_warnings();  
    if ( (length($msg)) && (($val > 0)||(VERB2())) ) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg);
    }
    ##prt("\n");
    close_log($outfile,$load_log);
    exit($val);
}

sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

sub sub_root_dir($$) {
    my ($dir,$rt) = @_;
    my $len = length($rt);
    return $dir if (length($dir) < $len);
    my ($k);
    for ($k = 0; $k < $len; $k++) {
        last if (lc(substr($dir,$k,1)) ne lc(substr($rt,$k,1)));
    }
    return $dir if ($k < $len);
    $dir = substr($dir,$k);
    $dir = substr($dir,1) if ($dir =~ /^(\\|\/)/);
    return $dir;
}

sub scan_directory($$) {
    my ($ind, $lev) = @_;
    my (@fils,$fcnt,$fil,@dirs,$ff,$indd,$sfn);
    my ($sb,$tm,$sz);
    @dirs = ();
    if (opendir DIR, $ind) {
        $total_dirs++;
        @fils = readdir(DIR);
        closedir DIR;
        $fcnt = scalar @fils;
        prt( "Got $fcnt items from [$ind]... scanning...\n" ) if (VERB9());
        $indd = $ind;
        $indd .= "\\" if (!($indd =~ /(\\|\/)$/));
        foreach $fil (@fils) {
            next if (($fil eq '.')||($fil eq '..'));
            $ff = $indd.$fil;
            # ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($filename);
            #  0    1    2     3     4    5     6     7     8
            # ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
            $tm = 0;
            $sz = 0;
            if ($sb = stat($ff)) {
                $tm = $sb->mtime;
                $sz = $sb->size;
            }
            if (-d $ff) {
                push(@dirs,$ff);
            } else {
                $sfn = sub_root_dir($ff,$root_dir);
                ##if ($block_size == 0) {   # FAILS IN WIN32
                ##    $block_size = $sb->blksize;
                ##    prt( "Set block size to $block_size...\n" );
                ##}
                push(@file_list,[ $sfn, $ff, $fil, $ind, $tm, $sz, 0 ]);
                $total_files++;
                $total_size += $sz;
            }
        }
        if ($recursive) {
            foreach $fil (@dirs) {
                scan_directory($fil, ($lev + 1));
            }
        }
    } else {
        prtw("WARNING: Can not open directory [$ind]!\n");
    }
}

sub path_2_dos($) {
    my ($d) = @_;
    $d =~ s/\//\\/g;
    return $d;
}

sub has_excluded_dir($) {
    my ($path) = @_;
    $path = path_2_dos($path);
    my @arr = split(/\\/,$path);
    foreach my $d (@arr) {
        if (defined $exclude_dirs{$d}) {
            return 1;
        }
    }
    return 0;
}

sub is_in_array_nc($$) {
	my ($itm, $rarr) = @_;
    $itm = lc($itm);
	foreach my $val (@{$rarr}) {
        $val = lc($val);
		if ($val eq $itm) {
			return 1;
		}
	}
	return 0;
}

sub get_nn($) { # perl nice number nicenum nice_num = add commas
	my ($n) = shift;
	if (length($n) > 3) {
		my $mod = length($n) % 3;
		my $ret = (($mod > 0) ? substr( $n, 0, $mod ) : '');
		my $mx = int( length($n) / 3 );
		for (my $i = 0; $i < $mx; $i++ ) {
			if (($mod == 0) && ($i == 0)) {
				$ret .= substr( $n, ($mod+(3*$i)), 3 );
			} else {
				$ret .= ',' . substr( $n, ($mod+(3*$i)), 3 );
			}
		}
		return $ret;
	}
	return $n;
}

# b2ks1 - bytes2ks bytestoks bytes_to_ks
sub bytes2ks($) {
	my ($d) = @_;
	my $oss;
	my $kss;
	my $lg = 0;
	my $ks = ($d / 1024); #// get Ks
	my $div = 1;
   if( $ks < 1024 ) {
      $div = 1;
      $oss = "KB";
   } elsif ( $ks < (1024*1024) ) {
	  $div = 1024;
      $oss = "MB";
   } elsif ( $ks < (1024*1024*1024) ) {
      $div = 1024*1024;
      $oss = "GB";
   } else {
      $div = 1024*1024*1024;
      $oss = "TB";
   }
   $kss = $ks / $div;
   $kss += 0.05;
   $kss *= 10;
   $lg = int($kss);
   return( ($lg / 10) . $oss );
}

sub get_size_msg($) {
    my ($sz) = @_;
    return get_nn($sz)." (".bytes2ks($sz).")";
}

sub got_includes() {
    my $cnt = scalar @include_exts;
    return $cnt;
}

sub is_in_includes($) {
    my ($ext) = @_;
    my $cnt = scalar @include_exts;
    if ($cnt) {
        if (is_in_array_nc($ext, \@include_exts)) {
            return 1;
        } else {
            return 0;
        }
    }
    return 1;   # all are OK, if NO INCLUDES
}

sub out_file_list($) {
    my ($out) = @_;
    my ($cnt,$sfn,$ff,$fil,$ind,$i,$msg);
    my ($nm,$dr,$ex);
    my ($tm,$sz);
    $cnt = scalar @file_list;
    prt( "[dbg03] Out $cnt files, to [$out]...\n" ) if ($dbg03);
    $msg = '';
    my $got_includes = got_includes();  # see if we have SPECIFIC INCLUDES
    my $dexclude = 0;
    my $eexclude = 0;
    my $iexclude = 0;
    my $exclude = 0;
    my $added = 0;
    my @dex = ();
    my @eex = ();
    my @iex = ();
    my $tsize = 0;
    for ($i = 0; $i < $cnt; $i++) {
        $sfn = $file_list[$i][0];
        $ff  = $file_list[$i][1];
        $fil = $file_list[$i][2];
        $ind = $file_list[$i][3];
        $tm  = $file_list[$i][4];
        $sz  = $file_list[$i][5];
        ($nm, $dr, $ex) = fileparse( $fil, qr/\.[^.]*/ );
        if ( has_excluded_dir($ind) ) {
            $dexclude++;
            push(@dex,$sfn);
        } elsif ($got_includes) {
            if (is_in_includes($ex) ) {
                $msg .= "$sfn\n";
                $tsize += $sz;
                $added++;
            } else {
                $iexclude++;
                push(@iex,$sfn);
            }
        } else {
            # NOT excluded directory, and NO specific INCLUDES, then

            if ( is_in_array_nc($ex, \@excluded_exts) ) {
                $eexclude++;
                push(@eex,$sfn);
            } else {
                $msg .= "$sfn\n";
                $tsize += $sz;
                $added++;
            }
        }
    }
    $exclude = $dexclude + $eexclude + $iexclude;
    $cnt -= $exclude;
    prt( "[dbg04] Excluded $exclude files, $dexclude by directory, $eexclude by extension, $iexclude not in includes...\n" ) if ($exclude && $dbg04);
    write2file($msg,$out);
    prt( "Scanned [$in_dir], list $cnt to [$out]... ".get_nn($tsize)." (".bytes2ks($tsize).") bytes...\n" );
    prt( "\nWritten $added to [$out]...\n$msg"."List of $added written to [$out]\n") if (VERB2());
    if (VERB9()) {
        if ($iexclude) {
            prt( "\nList of $iexclude excluded because NOT in INCLUDED extensions...\n" );
            foreach $fil (@dex) {
                prt("$fil\n");
            }
            prt( "Done list of $iexclude excluded because NOT in INCLUDED extensions...\n" );
        }
        if ($dexclude) {
            prt( "\nList of $dexclude excluded by directory...\n" );
            foreach $fil (@dex) {
                prt("$fil\n");
            }
            prt( "Done list of $dexclude excluded by directory...\n" );
        }
        if ($eexclude) {
            prt( "\nList of $eexclude excluded by extension...\n" );
            foreach $fil (@eex) {
                prt("$fil\n");
            }
            prt( "Done list of $eexclude excluded by extension...\n" );
        }
    }
}

#########################################
### MAIN ###
prt( "[dbg01] $pgmname: in [$cwd]: Hello, World...\n" ) if ($dbg01);
### prt( "Current OS = [$os]\n" );
parse_args(@ARGV);
scan_directory($in_dir,0);
prt( "[dbg02] Scanned $total_dirs directories, for $total_files files, ".get_size_msg($total_size)." bytes...\n" ) if ($dbg02);
out_file_list($out_file);
pgm_exit(0,"Normal exit(0)");
########################################

sub need_arg {
	my ($a, @b) = @_;
	if (! @b) {
		prt( "ERROR: Argument [$a] requires additional item!\n" );
        pgm_exit(1,"Exit BAD command argument.");
	}
}

# parse arguments... not sure why this has to be AFTER MAIN...
sub parse_args {
    my (@av) = @_;
    my $cnt = scalar @av;
    my ($arg,$sarg,$tmp,$act,$itm,$k,@arr);
    my ($lctmp,$lcitm,$msg);
    $msg = "Parsing $cnt arguments...\n";
    $act = '';
    while (@av) {
        $arg = $av[0];
        $act = '';
        if ($arg =~ /^(-|\/)/) {
            $sarg = substr($arg,1);
            if (($sarg =~ /\?/)||($sarg eq 'h')||($sarg eq '-help')) {
                give_help();
                pgm_exit(0,"Exit after help");
            } elsif ($sarg =~ /^-out(=|:)/) {
                $out_file = substr($sarg,5);
                $msg .= "Set out file to [$out_file]...\n";
            } elsif ($sarg =~ /^o(=|:)/) {
                $out_file = substr($sarg,2);
                $msg .= "Set out file to [$out_file]...\n";
            } elsif (($sarg eq 'o')||($sarg eq '-out')) {
                shift @av;
                need_arg($arg,@av);
                $out_file = $av[0];
                $msg .= "Set out file to [$out_file]...\n";
            } elsif ($sarg =~ /^-dir(=|:)/) {
                $in_dir = substr($sarg,5);
                $msg .= "Set in directory as [$in_dir]...\n";
            } elsif ($sarg =~ /^d(=|:)/) {
                $in_dir = substr($sarg,2);
                $msg .= "Set in directory as [$in_dir]...\n";
            } elsif (($sarg eq 'd')||($sarg eq '-dir')) {
                shift @av;
                need_arg($arg,@av);
                $in_dir = $av[0];
                $msg .= "Set in directory as [$in_dir]...\n";

            } elsif ($sarg =~ /^-add(=|:)/) {
                $tmp = substr($sarg,5);
                $act = 'a';
            } elsif ($sarg =~ /^a(=|:)/) {
                $tmp = substr($sarg,2);
                $act = 'a';
            } elsif (($sarg eq 'a')||($sarg eq '-add')) {
                shift @av;
                need_arg($arg,@av);
                $tmp = $av[0];
                $act = 'a';

            } elsif ($sarg =~ /^-sub(=|:)/) {
                $tmp = substr($sarg,5);
                $act = 's';
            } elsif ($sarg =~ /^s(=|:)/) {
                $tmp = substr($sarg,2);
                $act = 's';
            } elsif (($sarg eq 's')||($sarg eq '-sub')) {
                shift @av;
                need_arg($arg,@av);
                $tmp = $av[0];
                $act = 's';

            } elsif ($sarg =~ /^-inc(=|:)/) {
                $tmp = substr($sarg,5);
                $act = 'i';
            } elsif ($sarg =~ /^i(=|:)/) {
                $tmp = substr($sarg,2);
                $act = 'i';
            } elsif (($sarg eq 'i')||($sarg eq '-inc')) {
                shift @av;
                need_arg($arg,@av);
                $tmp = $av[0];
                $act = 'i';

            } elsif (($sarg eq 'R')||($sarg eq '-Remove')) {
                $cnt = scalar @excluded_exts;
                @excluded_exts = ();
                $msg .= "Removed ALL excluded extensions ($cnt to 0)\n";
            } elsif ($sarg =~ /^r/) {
                $recursive = 0;
            } elsif ($sarg =~ /^v/) {   # allow -vvvvv, and -v9...
                while ($sarg =~ /^v/) {
                    $verbosity++;
                    $sarg = substr($sarg,1);
                }
                if (length($sarg)) {
                    if ($sarg =~ /^\d+$/) {
                        $verbosity = $sarg;
                        $msg .= "Set verbosity to $verbosity...\n";
                    } else {
                        prt( "ERROR: Unknown argument [$arg]!\n" );
                        pgm_exit(1,"Exit BAD command argument.");
                    }
                } else {
                    $msg .= "Increased verbosity to $verbosity...\n";
                }
            } elsif ($sarg =~ /^-verb/) {
                $verbosity++;
                $msg .= "Increased verbosity to [$verbosity]...\n";
            } elsif (($sarg eq 'l')||($sarg eq '-load')) {
                $load_log = 1;
                $msg .= "Set load log at end...\n";
            } else {
                prt( "ERROR: Unknown argument [$arg]!\n" );
                pgm_exit(1,"Exit BAD command argument.");
            }
        } else {
            $in_dir = $arg;
            $msg .= "Set root directory as [$in_dir]...\n";
        }

        # ===================================================
        # post actions, if any
        # add an extension
        if ($act eq 'a') {
            $msg .= "Adding excluded extension [$tmp]... ";
            $cnt = scalar @excluded_exts;
            $lctmp = lc($tmp);
            for ($k = 0; $k < $cnt; $k++) {
                $itm = $excluded_exts[$k];
                $lcitm = lc($itm);
                last if ($lcitm eq $lctmp);
            }
            if ($k < $cnt) {
                $msg .= "already there!\n";
            } else {
                push(@excluded_exts,$tmp);
                $cnt = scalar @excluded_exts;
                $msg .= "ok ($cnt)\n";
            }
            $act = '';
        } elsif ($act eq 's') { # sub an extension
            $msg .= "Subbing excluded extension [$tmp]... ";
            $cnt = scalar @excluded_exts;
            @arr = ();
            $lctmp = lc($tmp);
            for ($k = 0; $k < $cnt; $k++) {
                $itm = $excluded_exts[$k];
                $lcitm = lc($itm);
                if ($lcitm eq $lctmp) {
                    $act = 'ok';
                } else {
                    push(@arr,$itm);
                }
            }
            if ($act eq 'ok') {
                $msg .= "ok.\n";
                @excluded_exts = @arr;
            } else {
                prt("ERROR: Extension [$tmp] NOT IN LIST!\n");
                pgm_exit(1,"Exit BAD command argument.");
            }
            $act = '';
        } elsif ($act eq 'i') {
            push(@include_exts,$tmp);
            $cnt = scalar @include_exts;
            $msg .= "Added [$tmp] to INCLUDE extensions ($cnt)\n";
            $act = '';
        }
        # ===========================
        shift @av;  # move to NEXT
        # ===========================
    }

    if (length($in_dir) == 0) {
        pgm_exit(1,"Error: No input directory given!");
    }
    if (! -d $in_dir) {
        pgm_exit(1,"Error: Can NOT stat input directory $in_dir!");
    }

    # post processing
    ($arg,$root_dir) = fileparse($in_dir);
    $msg .= "Set root_dir=[$root_dir] (nm=$arg)\n" ;
    prt( $msg ) if (VERB5());
}

# eof - filelist.pl