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