genmake.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:40 2010 from genmake.pl 2007/08/07 6.1 KB.

#!/perl -w
# NAME: genmake.pl
# AIM: Given an input folder, file mask, and destination folder,
# write a simple MAKEFILE to copy the found in files, to the destination.
# 29/05/2007 - geoff mclane - geoffmclane.com/mperl/index.htm
use strict;
use warnings;
use File::Basename;
unshift(@INC, 'C:/GTools/perl');
#my $in_folder = 'C:\FG\17\OpenSceneGraph\lib\release';
#my $in_folder = 'C:\FG\17\openscenegraph\lib\debug';
#my $in_folder = 'C:\FG\17\openscenegraph\lib\osgPlugins-1.9.5\debug';
my $xin_folder = 'C:\FG\18\OpenSceneGraph\lib\osgPlugins-2.1.3\release';
my $xdest_folder = 'C:\FG\18\bin';
my $xout_file = 'updpinr.mak';
my $in_folder = '';
my $dest_folder = '';
my $out_file = '';
my $perlname = $0;
my $file_mask = '*.dll';
if ($0 =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$0);
   $perlname = $tmpsp[-1];
}
my @in_files = ();
my $cnt = 0;
my $wrapat = 5;
my $wrap = 0;
my ($s1, $s2, $s3);
my @dstlist = ();
my @srclist = ();
# debug flags
my $dbg1 = 0;   # output also what is files
my $dbg2 = 0;   # show counts, lengths ...
parse_args( @ARGV );
get_in_files( $in_folder, $file_mask );
$cnt = scalar @in_files;
prt( "Got $cnt in files ...\n" );
my $sl = len_of_same($in_folder, $dest_folder);
prt( "Same length = $sl ...\n") if ($dbg2);
$s1 = substr($in_folder, $sl);
$s2 = substr($dest_folder, $sl);
prt( "Short = [$s1] [$s2] ...\n" ) if ($dbg2);
open OUTF, ">$out_file" or mydie( "ERROR: Unable to create $out_file\n" );
# output the MAKEFILE
prtf( "\n" );
prtf( "# makefile generated by $perlname on ".localtime(time())."\n" );
prtf( "\n" );
for (my $i = 0; $i < $cnt; $i++) {
   my $file = $in_files[$i];
   $s3 = substr($file, $sl);
   my $i2 = $i + 1;
   my ($nm, $dir) = fileparse($s3);
   push( @dstlist, "\$(dst$i2)" );
   push( @srclist, "\$(src$i2)" );
   prtf( "src$i2 = $s3\n" ); 
   prtf( "dst$i2 = $s2\\$nm\n" );
   prtf( "\n" );
}
prtf( "all: " );
for (my $i = 0; $i < $cnt; $i++) {
   my $dst = $dstlist[$i];
   prtf( "$dst " );
   $wrap++;
   if ($wrap >= $wrapat) {
      prtf( "\\\n     " );
      $wrap = 0;
   }
}
prtf( "\n" );
prtf( "\n" );
for (my $i = 0; $i < $cnt; $i++) {
   my $src = $srclist[$i];
   my $dst = $dstlist[$i];
   prtf( "$dst: $src\n" );
   prtf( "    copy $src $dst\n" );
   prtf( "\n" );
}
prtf( "\n" );
prtf( "# eof\n" );
close OUTF;
prt( "Written to $out_file makefile ...\n" );
###system( $out_file );
exit(0);
######################################
sub prtf {
   my ($msg) = shift;
   print OUTF $msg;
   prt( $msg ) if ($dbg1);
}
sub len_of_same {
   my ($f1, $f2) = @_;
   my $len = length($f1);
   my $i = 0;
   $len = length($f2) if (length($f2) < $len);
   for ($i = 0; $i < $len; $i++) {
      my $ch1 = uc(substr($f1,$i,1));
      my $ch2 = uc(substr($f2,$i,1));
      if ($ch1 ne $ch2) {
         last;
      }
   }
   return $i;
}
sub my_in_file {
   my ($inf, $mask) = @_;
   my ($nm1, $dir1, $ext1) = fileparse( $inf, qr/\.[^.]*/ );
   my ($nm2, $dir2, $ext2) = fileparse( $mask, qr/\.[^.]*/ );
   if ( ( (uc($nm1) cmp uc($nm2)) == 0 ) && ( (uc($ext1) cmp uc($ext2)) == 0 )) {
      return 1;
   }
   if (( (uc($nm1) cmp uc($nm2)) == 0 ) && length($ext1) && ($ext2 eq '.*')) {
      return 1;
   }
   if ( length($nm1) && ($nm2 eq '*') && ( (uc($ext1) cmp uc($ext2)) == 0 )) {
      return 1;
   }
   return 0;
}
sub get_in_files {
   my ($inf, $mask) = @_;
   prt( "Processing $inf folder ...\n" );
   if ( opendir( DIR, $inf ) ) {
      my @files = readdir(DIR);
      closedir DIR;
      foreach my $fl (@files) {
         if (($fl eq '.') || ($fl eq '..')) {
            next;
         }
         my $ff = $inf . "\\" . $fl;
         if (-d $ff) {
            next;
         } else {
            if (my_in_file($fl, $mask)) {
               push(@in_files, $ff);
            }
         }
      }
   } else {
      prt( "WARNING: Can NOT open $inf ... $! ...\n" );
   }
}
# Ensure argument exists, or die.
sub require_arg {
    my ($arg, @arglist) = @_;
    mydie( "ERROR: no argument given for option '$arg' ...\n" ) if ! @arglist;
}
sub help {
   prt( "$perlname - brief help\n" );
   prt( "$perlname -in in-folder -dest dest-folder -out out-file [-mask file-mask]" );
   prt( "(def=$file_mask)\n" );
   prt( " -i, -d, -o, or -m may also be used, or even --i, etc ...\n" );
   prt( "Example:\n" );
   prt( "$perlname -i $xin_folder -d $xdest_folder -o $xout_file\n" );
   prt( "Special -use_default to use the above ...\n" );
   exit(0);
}
sub parse_args { # @ARGV
   my (@av) = @_;
   while (@av) {
      my $arg = $av[0];
      if (substr($arg,0,1) eq '-') {
         if (substr($arg,1,1) eq '-') {
            $arg = substr($arg,1);
         }
         if ((lc($arg) eq '-?')||(lc($arg) eq '-h')||(lc($arg) eq '-help')) {
            help();
         } elsif ((lc($arg) eq '-in')||(lc($arg) eq '-i')) {
            require_arg(@av);
            shift @av;
            $in_folder = $av[0];
            prt( "Set input folder to [$in_folder] ...\n" );
         } elsif ((lc($arg) eq '-dest')||(lc($arg) eq '-d')) {
            require_arg(@av);
            shift @av;
            $dest_folder = $av[0];
            prt( "Set destination folder to [$dest_folder] ...\n" );
         } elsif ((lc($arg) eq '-out')||(lc($arg) eq '-o')) {
            require_arg(@av);
            shift @av;
            $out_file = $av[0];
            prt( "Set output file to [$out_file] ...\n" );
         } elsif ((lc($arg) eq '-mask')||(lc($arg) eq '-m')) {
            require_arg(@av);
            shift @av;
            $file_mask = $av[0];
            prt( "Set file mask to [$file_mask] ...\n" );
         } elsif ( (lc($arg) eq '-use_default') || (lc($arg) eq '-u') ) {
            $in_folder = $xin_folder;
            prt( "Set input folder to [$in_folder] ...\n" );
            $dest_folder = $xdest_folder;
            prt( "Set destination folder to [$dest_folder] ...\n" );
            $out_file = $xout_file;
            prt( "Set output file to [$out_file] ...\n" );
         } else {
            prt( "ERROR: Unknown $arg found ...\n" );
            help();
         }
      } else {
         prt( "ERROR: Unknown [$arg] found ...\n" );
         help();
      }
      shift @av;
   }
   if ((length($in_folder) == 0) ||
      (length($dest_folder) == 0) ||
      (length($out_file) == 0)) {
      my $msg = "ERROR: Missing ";
      if (length($in_folder) == 0) {
         $msg .= "-i in_folder ";
      }
      if (length($dest_folder) == 0) {
         $msg .= "-d dest_folder ";
      }
      if (length($out_file) == 0) {
         $msg .= "-o out_file ";
      }
      prt( "$msg\n" );
      help();
   }
}
sub prt {
   my ($t) = shift;
   print $t;
}
# eof - genmake.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional