Generated: Tue Feb 2 17:54:40 2010 from gensrclist.pl 2008/11/04 4.5 KB.
#!/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