gensrclist.pl to HTML.

index -|- end

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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional