#!/perl -w
# NAME: gensrclist.pl
# AIM: Given a FOLDER input, generate a source list of files in the folder,
# EXCLUDING those with extension in the @excluded_exts list.
# 04/11/2008 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;
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 $outfile = "temp.$pgmname.txt";
open_log($outfile);

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 .dsp .bsc );

# OPTIONS
my $recurse = 1;
my $ignoreCVS = 1;
my $exclude_ext = 1;
my $sub_root = 1;

my $root_folder = "C:\\FG\\19\\";
my $in_folder = 'OpenAL';

my $out_file = 'templist.txt';

my @warnings = ();

parse_args(@ARGV);

$root_folder .= "\\" if !($root_folder =~ /(\\|\/)$/);
my $in_dir = $root_folder;
$in_dir .= $in_folder;

prt( "$0 ... Hello, processing $in_dir folder, outputting list to $out_file ...\n" );

my @file_list = load_directory($in_dir);

prt( "Got ".scalar @file_list." files ... writing to $out_file ...\n" );

write2file( join("\n",@file_list), $out_file );
append2file( "\n", $out_file );

show_warnings(0);

close_log($outfile,0);
exit(0);

############################################
######## SUBS ONLY

sub give_help {
	prt( "Brief HELP for $0 script ...\n" );
	prt( "$0 -in:input_directory -out:output_file [-root:root_folder -subroot:(0|1)]\n" );
	ort( "Defaults: in:$in_folder, out:$out_file\n" );
	exit(0);
}

sub parse_args {
	my (@av) = @_;
	my ($arg, $ch, $val);
	while(@av) {
		$arg = shift @av;
		$ch = substr($arg,0,1);
		if ($arg =~ /\?/) {
			give_help();
		} elsif (($ch eq '-')||($ch eq '/')) {
			$val = substr($arg,1);
			if ($val =~ /^in:/) {
				$in_folder = substr($val,3);
				prt( "Set input directory to $in_folder ...\n" );
			} elsif ($val =~ /^out:/) {
				$out_file = substr($val,4);
				prt( "Set output file to $out_file ...\n" );
			} elsif ($val =~ /^root:/) {
				$root_folder = substr($val,5);
				prt( "Set root folder to $root_folder ...\n" );
			} elsif ($val =~ /^subroot:/) {
				$sub_root = substr($val,8);
				prt( "Set sub_root to $sub_root ...\n" );
			} else {
				prt( "ERROR: Unknown argument [$arg]!\n" );
				give_help();
			}
		} else {
			prt( "ERROR: Unknown argument [$arg]!\n" );
			give_help();
		}
	}
}


sub load_directory {
    my ($dir) = shift;
    my ($fil, $ff, $nm, $dr, $ex);
    my @files = ();
    my @dirs = ();
    my $len = length($root_folder);
	if ( opendir( DIR, $dir ) ) {
		my @fils = readdir(DIR);
		closedir DIR;
        foreach $fil (@fils) {
            next if (($fil eq '.')||($fil eq '..'));
            $ff = $dir."\\".$fil;
            if (-d $ff) {
                if (($fil =~ /^CVS$/i)||($fil =~ /^\.svn$/i)) {
                    push(@dirs,$ff) if (!$ignoreCVS);
                } else {
                    push(@dirs,$ff);
                }
            } else {
                if ($exclude_ext) {
                    ($nm, $dr, $ex) = fileparse( $fil, qr/\.[^.]*/ );
                    if (!is_in_array_nc($ex, @excluded_exts)) {
                        $ff = substr($ff,$len) if ($sub_root);
                        push(@files,$ff);
                    }
                } else {
                    $ff = substr($ff,$len) if ($sub_root);
                    push(@files,$ff);
                }
            }
        }
        if ($recurse) {
            foreach $fil (@dirs) {
                push(@files,load_directory($fil));
            }
        }
    } else {
        prtw( "WARNING: Failed to OPEN directory [$dir] ...\n" );
    }
    return @files;
}

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

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

sub show_warnings {
    my ($ocr) = shift;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS ...\n" );
        foreach my $line (@warnings) {
            prt("$line\n" );
        }
        prt("\n");
    } else {
        prt("\nNo warnings issued.\n\n") if ($ocr);
    }
}



# eof - gensrclist.pl

