fgchkaircraft.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:33 2010 from fgchkaircraft.pl 2008/12/07 11.1 KB.

#!perl -w
# NAME: fgchkaircraft.pl
# AIM: Check 'data/Aircraft' folder for valid aircraft ...
# 07/12/2008 - added 'status'
# 11/7/2008 - geoff mclane - http://geoffair.net/fg
use strict;
use warnings;
use File::Basename;
require 'fgutils.pl' or die "Unable to load fgutils.pl ...\n";
require 'fgscanvc.pl' or die "Unable to load fgscanvc.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);
$| = 1;      # set no print output buffering
my $in_folder = 'C:\FG\27\data\Aircraft';
my @warnings = ();
my $tempxml = 'tempxml.txt';
# OPTIONS
my $ord_byfdm = 1;
my $ord_author = 1;
my $ord_status = 1;
# DEBUG
my $dbg_cac01 = 0;   # show information during processing ...
my $dbg_cac02 = 0;   # write a tempxml.txt file of all files processed
my $dbg_cac03 = 1;   # show FAILED folders
my $dbg_cac04 = 0;   # show warning, even when NO warnings
my $dbg_cac05 = 1;   # load results in notepad
# MAIN
my %h = process_aircraft_folder($in_folder);    # get LIST from ALL <aircraft>-set.xml files
show_hash_ref( \%h );   # output the list
show_warnings($dbg_cac04);
close_log($outfile,$dbg_cac05);
exit(0);
##############################
### SUB ONLY
sub show_hash_ref {
   my ($hr) = shift;
   my ($key, $val, $itm, $msg, $max, $i);
   my $mlen = 10;
   my $desc = '';
   my $auth = '';
   my $fdm  = '';
   my $dir  = '';
   my $txt  = '';
    my $stat = '';
    my $ord  = '';
   my $mxline = 75;
   my $mxfdm = 7;
    if ($ord_byfdm) {
        $ord = "FDM";         # @oks = sort mycmp_ascend_a4 @ok;
    } elsif ($ord_author) {
        $ord = "AUTHOR";      #@oks = sort mycmp_ascend_a3 @ok;
    } elsif ($ord_status) {
        $ord = "STATUS";      #@oks = sort mycmp_ascend_a5 @ok;
    } else {
        $ord = "Alphabet";    #@oks = sort mycmp_ascend_asc @ok;
    }
   $key = 'OK';
   if (defined $$hr{$key}) {
      $val = $$hr{$key};
      $max = scalar @{$val};
      for ($i = 0; $i < $max; $i++) {
         $itm = $$val[$i][0];
         $fdm  = $$val[$i][4];
         $mlen = length($itm) if (length($itm) > $mlen);
         $mxfdm = length($fdm) if (length($fdm) > $mxfdm);
      }
   }
   foreach $key (keys %{$hr}) {
      $msg = '';
      $val = $$hr{$key};
      $max = scalar @{$val};
      $desc = '';
      $txt = '';
      prt( "\n$key aircraft = $max, ordered by $ord\n" );
      for ($i = 0; $i < $max; $i++) {
         $itm  = $$val[$i][0];
         $dir  = $$val[$i][1];
         $desc = $$val[$i][2];
         $auth = $$val[$i][3];
         $fdm  = $$val[$i][4];
            $stat = $$val[$i][5];
         if ($key eq 'OK') {
            $dir = '<same>' if ($itm eq $dir);
            $itm .= ' ' while (length($itm) < $mlen);
            $desc = '<none>' if (length($desc) == 0);
            $auth = '<unknown>' if (length($auth) == 0);
            $fdm  = '<def.>' if (length($fdm) == 0);
            $fdm .= ' ' while (length($fdm) < $mxfdm);
                $stat  = '<unknown>' if (length($stat) == 0);
            prt("$itm , fdm=$fdm , $stat, desc=$desc, auth=$auth, dir=$dir\n");
         } else {
            $txt .= ', ' if length($txt);
            $txt .= "[$itm]";
            if (length($txt) > $mxline) {
               $msg .= "$txt\n";
               $txt = '';
            }
         }
      }
      if ($key eq 'FAILED') {
         if ($dbg_cac03) {
            $msg .= $txt if length($txt);
            prt( "No Aircraft/folder/<aircraft>-set.xml file found in ...\n" );
            prt( "$msg\n" );
         }
      }
      prt( "$key listed $max by $ord\n" );
   }
}
sub process_folder {
    my ($ff, $setfiles, $aircraft) = @_;
    my ($df, $setfil, $air, @dfiles);
    if ( opendir( DIR, $ff) ) {
        @dfiles = readdir(DIR);
        close DIR;
        foreach $df (@dfiles) {
            next if (($df eq '.') || ($df eq '..'));
            next if ($df eq 'CVS');
            $setfil = $ff . "\\" . $df;
            if (-d $setfil) {
                # skip directories, OR
                process_folder( $setfil, $setfiles, $aircraft );
            } elsif ($df =~ /^(.+)-set.xml$/) {
                $air = $1;      # got an <aircraft>-set.xml file
                push(@$aircraft,$air);
                push(@$setfiles,$setfil);
            }
        }
    }
}
sub process_aircraft_folder {
   my ($inf) = shift;
   my @ok = ();
   my @failed = ();
   my %hash = ();
   my (@files, $fl, $ff, $setfil, $desc, @lines, $line, $lncnt, $xlncnt, %lnmap);
   my ($lnnum, $xln, @attribs, %atthash, $tag);
   my ($inpl, $insim, $indesc, $inauth, $instatus);
   my ($dotcnt, $auth, $mxdots);
   my ($infdm, $fdm, $air, $status);
   my (@dfiles, $df);
   my (@setfiles, @aircraft, $i, $setcnt);
   prt( "Processing $inf folder ...\n" );
   write2file( "Processing $inf folder ...\n",$tempxml ) if ($dbg_cac02);
   $dotcnt = 0;
   $mxdots = 70;
   if ( opendir( DIR, $inf ) ) {
      @files = readdir(DIR);
      closedir DIR;
      # maybe get all the ???-set.xml files ...
      foreach $fl (@files) {
         next if (($fl eq '.') || ($fl eq '..'));
         next if ($fl eq 'CVS');
         $ff = $inf . "\\" . $fl;
         $desc = '';
         $auth = '';
         $fdm = '';
         $setcnt = 0;
         $air = $fl;
         if (-d $ff) {
            # maybe the FOLDER contains ???-set.xml file(s) ...
            @setfiles = ();
            @aircraft = ();
            $setcnt = 0;
                process_folder( $ff, \@setfiles, \@aircraft );
#            if ( opendir( DIR, $ff) ) {
#               @dfiles = readdir(DIR);
#               close DIR;
#               foreach $df (@dfiles) {
#                  next if (($df eq '.') || ($df eq '..'));
#                  next if ($df eq 'CVS');
#                  $setfil = $ff . "\\" . $df;
#                  next if (-d $setfil);   # skip directories
#                  if ($df =~ /^(.+)-set.xml$/) {
#                     $air = $1;      # got an <aricraft>-set.xml file
#                     push(@aircraft,$air);
#                     push(@setfiles,$setfil);
#                  }
#               }
#            }
                $setcnt = scalar @setfiles;
            if ($setcnt) {
               if ($dbg_cac01) {
                  prt( "$fl = ok\n" );
               } else {
                  prt( '.' );
                  $dotcnt++;
                  if ($dotcnt > $mxdots) {
                     prt("\n");
                     $dotcnt = 0;
                  }
               }
               for ($i = 0; $i < $setcnt; $i++) {
                  $air    = $aircraft[$i];
                  $setfil = $setfiles[$i];
                  $desc = '';
                  $auth = '';
                  $fdm  = '';
                        $status = '';
                  if (open INF, "<$setfil") {
                     @lines = <INF>;
                     close INF;
                     $xlncnt = scalar @lines;
                     @lines = xml_array_to_lines(\%lnmap, @lines); # this re-lines the array
                     $lncnt = scalar @lines;
                     if ($dbg_cac02) {   # this is really ONLY FOR DEBUG
                        append2file( "\n$setfil\n",$tempxml );
                        append2file( join("\n",@lines),$tempxml );
                        append2file( "\n",$tempxml );
                     }
                     $inpl = 0;
                     $insim = 0;
                     $indesc = 0;
                     $inauth = 0;
                     $infdm = 0;
                            $instatus = 0;
                     foreach $line (@lines) {
                        $lnnum++;
                        $xln = $lnmap{$lnnum};
                        @attribs = space_split($line);   # split on 'space', but honour quoted text
                        $tag = $attribs[0];
                        if ($tag && length($tag)) {
                           if ($inpl) {
                              if ($tag =~ /^<\/PropertyList/) {
                                 $inpl = 0;
                              } elsif ($insim) {
                                 if ($indesc) {
                                    if ($tag =~ /^<\/description>/) {
                                       $indesc = 0;
                                    } else {
                                       $desc .= ' ' if length($desc);
                                       $desc .= $line;
                                    }
                                 } elsif ($inauth) {
                                    if ($tag =~ /^<\/author>/) {
                                       $inauth = 0;
                                    } else {
                                       $auth .= ' ' if length($auth);
                                       $auth .= $line;
                                    }
                                 } elsif ($infdm) {
                                    if ($tag =~ /^<\/flight-model>/) {
                                       $infdm = 0;
                                    } else {
                                       $fdm .= ' ' if length($fdm);
                                       $fdm .= $line;
                                    }
                                 } elsif ($instatus) {
                                    if ($tag =~ /^<\/status>/) {
                                       $instatus = 0;
                                    } else {
                                       $status .= ' ' if length($status);
                                       $status .= $line;
                                    }
                                 } else {
                                    if ($tag =~ /^<description>/) {
                                       $indesc = 1;
                                    } elsif ($tag =~ /^<author>/) {
                                       $inauth = 1;
                                    } elsif ($tag =~ /^<flight-model>/) {
                                       $infdm = 1;
                                    } elsif ($tag =~ /^<status>/) {
                                       $instatus = 1;
                                    }
                                 }
                              } elsif ($tag =~ /^<sim>/) {
                                 $insim = 1;
                              }
                           } elsif ($tag =~ /^<PropertyList/) {
                              %atthash = array_2_hash_on_equals(@attribs);
                              $inpl = 1;
                           }
                        }
                     }
                  } else {
                     prtw( "WARNING: Failed to open $setfil ...\n" );
                  }
                  # note the $air may NOT be the directory name
                        #          0     1    2      3      4     5
                  push(@ok, [$air, $fl, $desc, $auth, $fdm, $status]);
                  ###last;
                  $desc = '';
                  $auth = '';
                  $fdm = '';
                        $status = '';
               }
            } else {
               prt( "$fl = NOT FOUND $setfil\n" ) if ($dbg_cac01);
                    #               0   1    2      3      4     5
               push(@failed, [$fl, $fl, $desc, $auth, $fdm, $status]);
            }
         }
      }
      prt("\n") if (!$dbg_cac01 && $dotcnt);
   } else {
      prtw( "ERROR: Unable to open $inf ...\n" );
   }
   $hash{'FAILED'} = [ @failed ];
   my @oks = ();
    if ($ord_byfdm) {
        @oks = sort mycmp_ascend_a4 @ok;
    } elsif ($ord_author) {
        @oks = sort mycmp_ascend_a3 @ok;
    } elsif ($ord_status) {
        @oks = sort mycmp_ascend_a5 @ok;
    } else {
        @oks = sort mycmp_ascend_asc @ok;
    }
   $hash{'OK'}     = [ @oks    ];
   return %hash;
}
sub mycmp_decend_asc {
   if (${$a}[0] lt ${$b}[0]) {
      # prt( "+[".${$a}[0]."] lt [".${$b}[0]."]\n" ) if $verb3;
      return 1;
   }
   if (${$a}[0] gt ${$b}[0]) {
      # prt( "-[".${$a}[0]."] gt [".${$b}[0]."]\n" ) if $verb3;
      return -1;
   }
   # prt( "=[".${$a}[0]."] = [".${$b}[0]."]\n" ) if $verb3;
   return 0;
}
sub mycmp_ascend_asc {
   if (${$a}[0] lt ${$b}[0]) {
      # prt( "+[".${$a}[0]."] lt [".${$b}[0]."]\n" ) if $verb3;
      return -1;
   }
   if (${$a}[0] gt ${$b}[0]) {
      # prt( "-[".${$a}[0]."] gt [".${$b}[0]."]\n" ) if $verb3;
      return 1;
   }
   # prt( "=[".${$a}[0]."] = [".${$b}[0]."]\n" ) if $verb3;
   return 0;
}
sub mycmp_ascend_a5 {
   if (${$a}[5] lt ${$b}[5]) {
      return -1;
   }
   if (${$a}[5] gt ${$b}[5]) {
      return 1;
   }
   return 0;
}
sub mycmp_ascend_a4 {
   if (${$a}[4] lt ${$b}[4]) {
      return -1;
   }
   if (${$a}[4] gt ${$b}[4]) {
      return 1;
   }
   return 0;
}
sub mycmp_ascend_a3 {
   if (${$a}[3] lt ${$b}[3]) {
      return -1;
   }
   if (${$a}[3] gt ${$b}[3]) {
      return 1;
   }
   return 0;
}
#sub prt {
#   my ($t) = shift;
#   print $t;
#}
sub prtw {
    my ($tx) = shift;
    if ($tx =~ /\n$/) {
        prt($tx);
        $tx =~ s/\n$//;
    } else {
        prt("$tx\n");
    }
    push(@warnings,$tx);
}
sub show_warnings {
   my ($dbg) = shift;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS ...\n" );
        foreach my $line (@warnings) {
            prt("$line\n" );
        }
        prt("\n");
    } elsif ($dbg) {
        prt("\nNo warnings issued.\n\n");
    }
}
# eof - fgchkaircraft.pl

index -|- top