chklists.pl to HTML.

index -|- end

Generated: Sun Aug 21 11:10:42 2011 from chklists.pl 2011/04/27 6 KB.

#!/usr/bin/perl -w
# NAME: chklists.pl
# AIM: VERY SPECIFC - scan two lists...
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use Cwd;
my $perl_dir = 'C:\GTools\perl';
unshift(@INC, $perl_dir);
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# user variables
my $load_log = 1;
my $in_file = '';

my $debug_on = 1;
my $def_file = 'C:\FG\29\terrageargui\msvc\usage.txt';

my $set1 = "csShape";
# << "cs_agroforest" << "cs_airport" << "cs_asphalt" << "cs_barrencover" << "cs_bog" << "cs_burnt" << "cs_canal" << "cs_cemetery" << "cs_complexcrop" << "cs_construction" << "cs_cropgrass" << "cs_deciduousforest" << "cs_default" << "cs_dirt" << "cs_drycrop" << "cs_dump" << "cs_estuary" << "cs_evergreenforest" << "cs_floodland" << "cs_freeway" << "cs_glacier" << "cs_golfcourse" << "cs_grassland" << "cs_greenspace" << "cs_heath" << "cs_hebtundra" << "cs_industrial" << "cs_intermittentlake" << "cs_intermittentstream" << "cs_irrcrop" << "cs_lagoon" << "cs_lake" << "cs_lava" << "cs_littoral" << "cs_marsh" << "cs_mixedcrop" << "cs_mixedforest" << "cs_naturalcrop" << "cs_olives" << "cs_openmining" << "cs_orchard" << "cs_packice" << "cs_polarice" << "cs_port" << "cs_railroad1" << "cs_railroad2" << "cs_rainforest" << "cs_rice" << "cs_road" << "cs_rock" << "cs_saline" << "cs_saltmarsh" << "cs_sand" << "cs_sclerophyllous" << "cs_scrub" << "cs_stream" << "cs_suburban" << "cs_town" << "cs_transport" << "cs_urban" << "cs_ineyard" << "cs_watercourse";
# // list of correpsonding materials
my $set2 = "csMater";
#    csMater << "AgroForest" << "Airport" << "Asphalt" << "BarrenCover" << "Bog" << "Burnt" << "Canal" << "Cemetery" << "ComplexCrop" << "Construction" << "CropGrass" << "DeciduousForest" << "Default" << "Dirt" << "DryCrop" << "Dump" << "Estuary" << "EvergreenForest" << "FloodLand" << "Freeway" << "Glacier" << "GolfCourse" << "GrassLand" << "GreenSpace" << "Heath" << "HerbTundra" << "Industrial" << "IntermittentLake" << "IntermittentStream" << "IrrCrop" << "Lagoon" << "Lake" << "Lava" << "Littoral" << "Marsh" << "MixedCrop" << "MixedForest" << "NaturalCrop" << "Olives" << "OpenMining" << "Orchard" << "PackIce" << "PolarIce" << "Port" << "Railroad" << "Railroad" << "RainForest" << "Rice" << "Rock" << "Saline" << "SaltMarsh" << "Sand" << "Sclerophyllous" << "ScrubCover" << "Stream" << "SubUrban" << "Town" << "Transport" << "Urban" << "Vineyard" << "Watercourse";

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;

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

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


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

sub process_in_file($) {
    my ($inf) = @_;
    if (! open INF, "<$inf") {
        pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); 
    }
    my @lines = <INF>;
    close INF;
    my $lncnt = scalar @lines;
    prt("Processing $lncnt lines, from [$inf]...\n");
    my ($line,$inc,$lnn);
    $lnn = 0;
    my @list1 = ();
    my @list2 = ();
    foreach $line (@lines) {
        chomp $line;
        $lnn++;
        if ($line =~ /\s*$set1/) {
            #prt("$lnn: $line\n");
            @list1 = split(/\s+<<\s+/,$line);
        } elsif ($line =~ /\s*$set2/) {
            #prt("$lnn: $line\n");
            @list2 = split(/\s+<<\s+/,$line);
        }
    }
    my $cnt1 = scalar @list1;
    my $cnt2 = scalar @list2;
    prt("Got $cnt1 list1, $cnt2 list2 items...\n");
    my $cnt = $cnt1;
    $cnt = $cnt2 if ($cnt2 < $cnt2);
    my ($i,$v1,$v2,$len,$min);
    $min = 0;
    for ($i = 0; $i < $cnt; $i++) {
        $v1 = $list1[$i];
        $len = length($v1);
        $min = $len if ($len > $min);
    }
    for ($i = 0; $i < $cnt; $i++) {
        $v1 = $list1[$i];
        $v2 = $list2[$i];
        $v1 .= ' ' while (length($v1) < $min);
        prt("$v1 = $v2\n");
    }
}

#########################################
### MAIN ###
parse_args(@ARGV);
#prt( "$pgmname: in [$cwd]: Hello, World...\n" );
process_in_file($in_file);
pgm_exit(0,"Normal exit(0)");
########################################
sub give_help {
    prt("$pgmname: version 0.0.1 2010-09-11\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help (-h or -?) = This help, and exit 0.\n");
}
sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av);
}

sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if (($sarg =~ /^h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_file = $arg;
            prt("Set input to [$in_file]\n");
        }
        shift @av;
    }

    if ((length($in_file) ==  0) && $debug_on) {
        $in_file = $def_file;
    }
    if (length($in_file) ==  0) {
        pgm_exit(1,"ERROR: No input files found in command!\n");
    }
    if (! -f $in_file) {
        pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n");
    }
}

# eof - template.pl

index -|- top