newproj.pl to HTML.

index -|- end

Generated: Sat Oct 12 17:23:11 2013 from newproj.pl 2012/12/07 18.4 KB. text copy

#!/perl -w
# NAME: newproj.pl
# AIM: QUITE SPECIAL - Take the BLANK project, and given a new ouput directory
# and project name, copy BLANK to there, and change the names...
# 07/12/2012 - Finalize - and shift to CMake building
# 06/08/2010 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use Cwd;
use File::Copy;
unshift(@INC, 'C:\GTools\perl');
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
    my @tmpsp = split(/\\/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $perl_dir = 'C:\GTools\perl';
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);


# user variables
my $VERS = "0.0.2 2012-12-07";
#my $VERS = "0.0.1 2010-08-06";
my $load_log = 0;
my $in_project = '';
my $in_short = '';
my $out_directory = '';
my $in_directory1 = 'C:\GTools\tools\BLANK';
my @in_files1 = qw( ap4_about.cxx ap4_about.hxx ap4_command.cxx ap4_command.hxx ap4_ini.cxx
ap4_ini.hxx ap4_maths.cxx ap4_maths.hxx ap4_paint.cxx ap4_paint.hxx ap4_range.cxx ap4_range.hxx
ap4_sprtf.cxx ap4_sprtf.hxx ap4_test.cxx ap4_test.hxx ap4_timer.cxx ap4_timer.hxx ap4_tri.cxx
ap4_tri.hxx ap4_utils.cxx ap4_utils.hxx ap4_vers.hxx ReadMe.txt Resource.h small.ico testap4.cxx
testap4.hxx testap4.ico testap4.rc upd.bat update.mak
ap4_list.cxx ap4_list.hxx ap4_track.cxx ap4_track.hxx);

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my $act_file = '';
my $verbosity = 0;

# prog vars
my $filelist = '';

# DEBUG
my $debug_on = 0;
my $def_output = 'C:\GTools\tools\temp';
my $def_project = 'defproj';
my $def_short = 'dfp';

sub VERB1() { return $verbosity >= 1; }
sub VERB2() { return $verbosity >= 2; }
sub VERB5() { return $verbosity >= 5; }
sub VERB9() { return $verbosity >= 9; }

sub get_in_dir() {
    return $in_directory1;
}

sub get_in_files() {
    return \@in_files1;
}

sub get_new_file_name($) {
    my ($fil) = @_;
    if ($fil =~ /^ap4_/) {
        $fil =~ s/^ap4/$in_short/;
    } elsif ($fil =~ /^testap4/) {
        $fil =~ s/^testap4/$in_project/;
    }
    return $fil;
}

sub fix_solution_file($) {
    my ($ra) = @_;
    my $max = scalar @{$ra};
    prt("Fixing solution file...$max lines\n") if (VERB1());
    my ($i,$line);
    my $ret = 0;
    for ($i = 0; $i < $max; $i++) {
        $line = ${$ra}[$i];
        if ($line =~ /^Project\("\{/) {
            # 8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testap4", "testap4.vcproj", "{74893561-F25A-42CF-AB44-DB998D983D8A}"
            $line =~ s/testap4/$in_project/g;
            ${$ra}[$i] = $line;
            $ret++;
        }
    }
    return $ret;
}

sub fix_vcproj_file($) {
    my ($ra) = @_;
    my $max = scalar @{$ra};
    prt("Fixing vcproj file...$max lines\n") if (VERB1());
    my ($i,$line,$inc,$nfil);
    my $ret = 0;
    for ($i = 0; $i < $max; $i++) {
        $line = ${$ra}[$i];
        if ($line =~ /^\s*RelativePath="(.+)"/) {
            $inc = $1;
            $inc =~ s/^\.(\\|\/)//;
            $nfil = get_new_file_name($inc);
            if ($nfil ne $inc) {
                $line =~ s/$inc/$nfil/;
                ${$ra}[$i] = $line;
                prt("Fix the SOURCE [$inc] [$nfil]\n") if (VERB1());
                $ret++;
            } else {
                prt("NO Fix for SOURCE [$inc]\n") if (VERB1());
            }
        } elsif ($line =~ /testap4/) {
            $line =~ s/testap4/$in_project/g;
            ${$ra}[$i] = $line;
            $ret++;
        }
    }
    return $ret;
}

# file dfp_ini.cxx
# // ap4_ini.cxx
# static  char    g_szDefIni[] = "testap4.ini";
# // eof - ap4_ini.cxx

# file dfp_ini.hxx
# // ap4_ini.hxx
# #ifndef _ap4_Ini_hxx_
# #define _ap4_Ini_hxx_
# #endif // #ifndef _ap4_Ini_hxx_
# // eof - ap4_ini.hxx
sub fix_source_items($) {
    my ($ra) = @_;
    my $max = scalar @{$ra};
    my ($i,$line,$inc,$nfil);
    my $ret = 0;
    for ($i = 0; $i < $max; $i++) {
        $line = ${$ra}[$i];
        if ($line =~ /^\s*#\s*include\s+(<|")(.+)(<|")/) {
            $inc = $2;
            $nfil = get_new_file_name($inc);
            if ($inc ne $nfil) {
                $line =~ s/$inc/$nfil/;
                ${$ra}[$i] = $line;
                prt("Fixed the INCLUDE [$inc] to [$nfil]\n") if (VERB1());
                $ret++;
            } else {
                prt("NO Fix the INCLUDE [$inc]\n") if (VERB1());
            }
        } elsif ($line =~ /^\s*\/\/(.*)ap4_/) {
            $line =~ s/ap4/$in_short/;
            ${$ra}[$i] = $line;
            $ret++;
        } elsif ($line =~ /^\s*#(.*)ap4_/) {
            $line =~ s/ap4/$in_short/;
            ${$ra}[$i] = $line;
            $ret++;
        } elsif ($line =~ /testap4/) {
            $line =~ s/testap4/$in_project/;
            ${$ra}[$i] = $line;
            $ret++;
        } elsif ($line =~ /tempap4/) {
            $line =~ s/tempap4/temp$in_short/;
            ${$ra}[$i] = $line;
            $ret++;
        }
    }
    return $ret;
}

sub fix_cxx_file($) {
    my ($ra) = @_;
    my $max = scalar @{$ra};
    prt("Fixing cxx file...$max lines\n") if (VERB1());
    my $ret = fix_source_items($ra);
    return $ret;
}
sub fix_hxx_file($) {
    my ($ra) = @_;
    my $max = scalar @{$ra};
    prt("Fixing hxx file...$max lines\n") if (VERB1());
    my $ret = fix_source_items($ra);
    return $ret;
}

sub fix_text_file($) {
    my ($ra) = @_;
    my $max = scalar @{$ra};
    prt("Fixing text file...$max lines\n") if (VERB1());
    my ($i,$line,$inc,$nfil);
    my $ret = 0;
    for ($i = 0; $i < $max; $i++) {
        $line = ${$ra}[$i];
        if ($line =~ /testap4/) {
            $line =~ s/testap4/$in_project/g;
            ${$ra}[$i] = $line;
            $ret++;
        }
        if ($line =~ /ap4_/) {
            $line =~ s/ap4/$in_short/g;
            ${$ra}[$i] = $line;
            $ret++;
        }
    }
    return $ret;
}


my %file_list = (
    '.sln' => \&fix_solution_file,
    '.vcproj' => \&fix_vcproj_file,
    '.cxx' => \&fix_cxx_file,
    '.hxx' => \&fix_hxx_file,
    '.h' => \&fix_hxx_file,
    '.txt' => \&fix_text_file,
    '.bat' => \&fix_text_file,
    '.rc' => \&fix_text_file,
    );


sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg)
    }
    close_log($outfile,$load_log);
    exit($val);
}


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

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

sub test_files_exist() {
    my $dir = get_in_dir();
    $dir .= "\\" if ( !($dir =~ /(\\|\/)$/) );
    my ($file,$ff);
    my $rfa = get_in_files();
    foreach $file (@{$rfa}) {
        $ff = $dir.$file;
        if ( ! -f $ff ) {
            #pgm_exit(1,"ERROR: Can NOT locate file [$file], in [$dir]!\n");
            pgm_exit(1,"ERROR: Can NOT locate file [$ff]!\n");
        }
    }
    prt( "All files found...\n") if (VERB1() > 1);
}

# skip 
# testap4.ini, testap4.sdf testap4.sln.old testap4.suo testap4.vcxproj
sub check_setup() {
    test_files_exist();
    my $dir = get_in_dir();
    if (!opendir(DIR,$dir)) {
        pgm_exit(1,"ERROR: Source directory [$dir] does NOT exist!\n*** FIX ME ***\n");
    }
    my @files = readdir(DIR);
    closedir(DIR);
    my $fcnt = scalar @files;
    prt("Found $fcnt file items in [$dir]\n") if (VERB9());
    my $rfa = get_in_files();
    my ($fil1,$fil2,$ff,$fnd);
    ut_fix_directory(\$dir);
    foreach $fil1 (@files) {
        next if ($fil1 eq '.');
        next if ($fil1 eq '..');
        next if ($fil1 =~ /.+\.zip$/i); # skip zip
        next if ($fil1 =~ /.+\.ini$/i); # skip ini
        next if ($fil1 =~ /.+\.sdf$/i); # skip sdf
        next if ($fil1 =~ /.+\.old$/i); # skip old
        next if ($fil1 =~ /.+\.suo$/i); # skip suo
        next if ($fil1 =~ /.+\.sln$/i); # skip suo
        next if ($fil1 =~ /.+\.vcproj$/i); # skip vcproj
        next if ($fil1 =~ /.+\.vcxproj/i); # skip vcxproj
        next if ($fil1 =~ /^temp/); # skip temp

        $fnd = 0;
        $ff = $dir.$fil1;
        next if (-d $ff); # skip directories
        foreach $fil2 (@{$rfa}) {
            if ($fil1 eq $fil2) {
                $fnd = 1;
                last;
            }
        }
        if (!$fnd) {
            prtw("WARNING: File [$fil1] NOT in LIST!\n");
        }
    }
}


sub make_out_dir($) {
    my ($dir) = @_;
    if (-d $dir) {
        if (opendir(IND,$dir)) {
            my @files = readdir(IND);
            closedir(IND);
            my $cnt = 0;
            ut_fix_directory(\$dir);
            my ($ff);
            foreach my $fil (@files) {
                next if (($fil eq '.')||($fil eq '..'));
                $ff = $dir.$fil;
                next if (-d $ff);
                $cnt++;
            }
            if ($cnt) {
                prt("ERROR: Directory [$dir] is NOT empty! Contains $cnt files...\n");
                pgm_exit(1,"ERROR: Directory NOT EMPTY... aborting...\n\n");
            }
        } else {
           prtw("WARNING: FAILED to open the directory [$dir] to check content!\n");
        }
    } else {
        prt("ERROR: Directory [$dir] does NOT EXIST! Will NOT create!\n");
        pgm_exit(1,"ERROR: Create [$dir], and run again... aborting...\n\n");
        # or we could just CREATE it!!!
        # =============================
        $dir = path_u2d($dir);
        my (@arr,$ndir,$cnt,$i,$i2,$itm);
        @arr = split(/\\/,$dir);
        $cnt = scalar @arr;
        $ndir = $arr[0];
        for ($i = 1; $i < $cnt; $i++) {
            $i2 = $i + 1;
            $ndir .= "\\";
            $itm = $arr[$i];
            $ndir .= $itm;
            if (! -d $ndir) {
                if ($i2 < $cnt) {
                    pgm_exit(1,"ERROR: Directory [$ndir] does NOT EXIST! Will only create one level!\n");
                } else {
                    prt("Making directory [$itm]\n");
                    mkdir $ndir;
                    if (! -d $ndir) {
                        pgm_exit(1,"ERROR: FAILED to make the directory [$itm]! ie [$ndir]\n");
                    }
                }
            }
        }
    }
}

sub test_files_not_exist($) {
    my ($dir) = @_;
    $dir .= "\\" if ( !($dir =~ /(\\|\/)$/) );
    my ($file,$ff,$nfile);
    my $rfa = get_in_files();
    foreach $file (@{$rfa}) {
        $nfile = get_new_file_name($file);
        $ff = $dir.$nfile;
        if ( -f $ff ) {
            pgm_exit(1,"ERROR: File [$ff] EXISTS! Will NOT overwrite...\n");
        }
    }
    # prt( "No files found...\n") if (VERB1() > 1);
}

sub chomp_lines($) {
    my ($ra) = @_;
    my $max = scalar @{$ra};
    my ($i,$line);
    for ($i = 0; $i < $max; $i++) {
        $line = ${$ra}[$i];
        chomp $line;
        ${$ra}[$i] = $line;
    }
}

sub copy_all_files($) {
    my ($dir) = @_;
    my $idir = get_in_dir();
    $dir .= "\\" if ( !($dir =~ /(\\|\/)$/) );
    $idir .= "\\" if ( !($idir =~ /(\\|\/)$/) );
    my ($file,$ff1,$ff2,$nfile);
    my ($nm,$dr,$ex,@lines,$func,$ret); 
    my $rfa = get_in_files();
    foreach $file (@{$rfa}) {
        $act_file = $file;
        ($nm,$dr,$ex) = fileparse( $file, qr/\.[^.]*/ );
        prt("Processing file [$file]... extent [$ex]\n") if (VERB1());
        $ff1 = $idir.$file;
        $nfile = get_new_file_name($file);
        $ff2 = $dir.$nfile;
        $filelist .= $nfile\n";
        if ( ( -f $ff1 ) && !( -f $ff2 )) {
            #prt( "Copy [$ff1] to [$ff2]... extent [$ex]\n");
            if (defined $file_list{$ex}) {
                $func = $file_list{$ex};
                if (!open INF, "<$ff1") {
                    pgm_exit(1,"ERROR: Unable to OPEN file [$ff1]\n");
                }
                @lines = <INF>;
                chomp_lines( \@lines );
                $ret = $func->( \@lines );
                write2file(join("\n",@lines)."\n", $ff2);
                prt("Written to [$ff2] changes $ret\n") if (VERB1());
            } else {
                if ( copy( $ff1, $ff2 ) ) {
                    if (-f $ff2) {
                        prt("Copied to [$ff2]\n") if (VERB1());
                    } else {
                        pgm_exit(1,"ERROR: Copy FAILED on [$ff2]\n");
                    }
                } else {
                    pgm_exit(1,"ERROR: Copy FAILED for [$ff2]\n");
                }
            }
        } else {
            if (-f $ff1) {
                pgm_exit(1,"ERROR: Copy NOT DONE! Existing [$ff2]\n");
            } else {
                pgm_exit(1,"ERROR: Copy NOT DONE! Missing [$ff1] [$ff2]\n");
            }
        }
    }
    prt( "All files copied...\n") if (VERB1());
}

sub write_cmake($) {
    my $dir = shift;
    my $cmake = "# project $in_project\n";
    $cmake .= "project( $in_project )\n";
    $cmake .= "set (SRCS\n";
    $filelist =~ s/\n$//;
    $cmake .= $filelist . ")\n";
    $cmake .= "add_executable( $in_project WIN32 \${SRCS} )\n";
    ut_fix_directory(\$dir);
    my $ff = $dir."CMakeLists.txt";
    write2file($cmake,$ff);
    prt("Written [$ff]\n");
}

#########################################
### MAIN ###
parse_args(@ARGV);
#prt( "$pgmname: in [$cwd]: Hello, World...\n" );
test_files_exist();
make_out_dir($out_directory);
# test_files_not_exist($out_directory);
copy_all_files($out_directory);
write_cmake($out_directory);
pgm_exit(0,"Normal exit(0)");
########################################

sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have following argument!\n")
        if (!@av);
}

sub check_for_verbose {
    my (@av) = @_;
    while (@av) {
        my $arg = $av[0];
        if ($arg =~ /^-/) {
            my $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /-/);
            if ($sarg =~ /^v/) {
                if ($sarg =~ /^v.+(\d+)$/) {
                    $verbosity = $1;
                } else {
                    while ($sarg =~ /^v/) {
                        $sarg = substr($sarg,1);
                        $verbosity++;
                    }
                }
            }
        }
        shift @av;
    }
}


sub parse_args {
    my (@av) = @_;
    check_for_verbose(@av);
    while (@av) {
        my $arg = $av[0];
        if ($arg =~ /^-/) {
            my $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /-/);
            if (($sarg =~ /h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } elsif ($sarg =~ /^v/i) {
                # already done
            } elsif ($sarg =~ /^out=/i) {
                $sarg = substr($sarg,4);
                $out_directory = $sarg;
                prt("Set output directory to [$out_directory]\n") if (VERB1());
            } elsif ($sarg =~ /^o/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $out_directory = $sarg;
                prt("Set output directory to [$out_directory]\n") if (VERB1());
            } elsif ($sarg =~ /^name=/i) {
                $sarg = substr($sarg,5);
                $in_project = $sarg;
                prt("Set project name to [$in_project]\n") if (VERB1());
            } elsif ($sarg =~ /^n/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $in_project = $sarg;
                prt("Set project name to [$in_project]\n") if (VERB1());
            } elsif ($sarg =~ /^sn=/i) {
                $sarg = substr($sarg,3);
                $in_short = $sarg;
                prt("Set short project name to [$in_short]\n") if (VERB1());
            } elsif ($sarg =~ /^s/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $in_short = $sarg;
                prt("Set project name to [$in_short]\n") if (VERB1());
            } elsif ($sarg =~ /^l/i) {
                $load_log = 1;
                prt("Set to load log at end.\n") if (VERB1());
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_project = $arg;
            prt("Set project name to [$in_project]\n") if (VERB1());
        }
        shift @av;
    }

    if ($debug_on) {
        if (length($in_project) == 0) {
            $in_project = $def_project;
            prt("[debug_on] Set project name to DEFAULT [$in_project]\n");
        }
        if (length($in_short) == 0) {
            $in_short = $def_short;
            prt("[debug_on] Set short project name to DEFAULT [$in_short]\n");
        }
        if (length($out_directory) == 0) {
            $out_directory = $def_output;
            prt("[debug_on] Set output directory to DEFAULT [$out_directory]\n");
        }
        $load_log = 1;
    }

    #check_setup();

    if (length($in_project) == 0) {
        pgm_exit(1,"ERROR: No project name found in command!\n");
    }
    if (length($in_short) == 0) {
        pgm_exit(1,"ERROR: No short project name found in command!\n");
    }
    if (length($out_directory) == 0) {
        pgm_exit(1,"ERROR: No output directory found in command!\n");
    }
}

sub give_help {
    prt("$pgmname: version $VERS\n");
    prt("Usage: $pgmname [options] [name]\n");
    prt(" --help      (-? -h) = This help, and exit 0\n");
    prt(" --out=<dir>    (-o) = Given OUTPUT directory. Will NOT be created. Must EXIST, and be EMPTY\n");
    prt(" --sn=<name>    (-s) = Short version of the name.\n");
    prt(" --ll           (-l) = Load log at end.\n");
    prt(" --v            (-v) = Increase verbosity.\n");
    prt("Any bare argument will be taken as the 'name' of the project.\n");
    prt("Will COPY the files from BLANK, changing the source file names appropriately, and will\n");
    prt("replace all instances of 'testap4' and 'ap4_', with project name, and short name respectively,\n");
    prt("ready for a new build in the output directory.\n");
}

# eof - newproj.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional