Generated: Tue Feb 2 17:54:35 2010 from fgshowmaterials.pl 2009/02/27 8.3 KB.
#!/perl -w # NAME: fgshowmaterials.pl # AIM: Very specific show of 'materials' defined in FG data 'materials.xml' # 27/02/2009 geoff mclane http://geoffair.net/mperl use strict; use warnings; require 'logfile.pl' or die "Unable to load logfile.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); my $in_file = "C:\\FG\\27\\data\\materials.xml"; # features my $skipsingles = 1; # skip names that are length of just 1 my $skipdoubles = 1; # skip names that are length of just 2 my $skip_pa = 1; # skip if commencing with 'pa_' my $skip_pc = 1; # skip if commencing with 'pc_' my $skip_cavete = 1; # skip if commencing with '^???' my $skip_dirt = 1; # skip if commencing with 'dirt_' my $skip_RWY = 1; # skip if commencing with 'RWY_' my $skip_Sign = 1; # skip is contains 'Sign' # debug my $dbg1 = 0; # show enter/ext 'material' prt( "$0 ... Processing $in_file...\n" ); sub trim_xml($) { my ($ln) = shift; $ln =~ s/\n/ /gm; # replace CR (\n) $ln =~ s/\r/ /gm; # replace LF (\r) ### $ln =~ s/\t/ /g; # TAB(s) to a SPACE $ln = substr($ln,1) while ($ln =~ /^\s/); # remove all LEADING space $ln = substr($ln,0, length($ln) - 1) while ($ln =~ /\s$/); # remove all TRAILING space ### $ln =~ s/\s{2}/ /g while ($ln =~ /\s{2}/); # all double space to SINGLE return $ln; } # relinexml - 20090125 # Need to add some options, like # - indenting # <open>text</close> on same line sub xml_to_lines { my ($rlm, @lns) = @_; my $intag = 0; my $text = ''; # gather TEXT between tags my @nlines = (); my ($fln, $ln, $ch, $pch, $nch, $len, $i, $i2, $tag, $xml, $dnx); my ($lnnm, $lnb, $nlnm); my ($ppch, $incomm); my $show_comm_dbg = 0; $pch = ''; $ppch = ''; $nch = ''; $tag = ''; $xml = ''; $dnx = 0; $lnnm = 0; $nlnm = 0; $lnb = 0; $incomm = 0; $text = ''; # start NO TEXT foreach $fln (@lns) { chomp $fln; $ln = trim_xml($fln); $len = length($ln); $lnnm++; # count another xml line for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $ch = substr($ln,$i,1); $nch = (($i2 < $len) ? substr($ln,$i2,1) : ' '); if ($intag) { # on first GREATER THAN - SPACE $tag .= $ch; if ($ch eq '>') { if ( $incomm ) { prt("$lnnm: potential end of XML tag pch=$pch ppch=$ppch\n") if ($show_comm_dbg); if (($pch eq '-') && ($ppch eq '-')) { $nlnm++; push(@nlines,$tag); ### prt( "push(\@xlnmap, [ $nlnm, $lnb, $lnnm ]); # each NEW line has BEGIN and END\n" ); $$rlm{$nlnm} = "$lnb-$lnnm"; # each NEW line has BEGIN and END $tag = ''; $intag = 0; $xml = ''; $incomm = 0; prt( "$lnnm: Exit comment [$ln]\n" ) if ($show_comm_dbg); } } else { $nlnm++; push(@nlines,$tag); ### prt( "push(\@xlnmap, [ $nlnm, $lnb, $lnnm ]); # each NEW line has BEGIN and END\n" ); $$rlm{$nlnm} = "$lnb-$lnnm"; # each NEW line has BEGIN and END $tag = ''; $intag = 0; $xml = ''; $incomm = 0; } } } else { if ($ch eq '<') { if (length($text)) { $nlnm++; push(@nlines,$text); $$rlm{$nlnm} = "$lnb-$lnnm"; # each NEW line has BEGIN and END $text = ''; } $tag = $ch; # start a tag line $intag = 1; # signal in a tag $xml = ''; $dnx = 0; $lnb = $lnnm; # set the BEGIN xml line if ($nch eq '!') { # but watch out for <!DOCTYPE ...> if ($ln =~ /<!--/) { prt( "$lnnm: Entering comment [$ln]\n" ) if ($show_comm_dbg); $incomm = 1; } } } else { $text .= $ch; } } $ppch = $pch; $pch = $ch; } # done a line - this is like a SPACE if ($intag && length($tag)) { $tag .= ' ' if !($tag =~ /(=|\s)$/); } } prtw("WARNING: Exit STILL in comment!\n") if ($incomm); if (length($tag)) { prtw("WARNING: xml re-lining error! Left pending tag [$tag]\nin $in_file file ...\n"); } return @nlines; } sub outfile($$) { my ($fil, $tx) = @_; if (open OUTF, ">$fil") { print OUTF $tx; close OUTF; } else { prt("ERROR: Could not create $fil!\n"); } } sub process_in_file($) { my ($inf) = shift; my ($lncnt, $max, $line, @lines, $inmat, $ln, $names, $inname, $len, $addit); my %lnmap = (); if (open INF, "<$inf") { @lines = <INF>; close INF; my $lncnt = scalar @lines; prt( "Processing $lncnt lines from $inf...\n" ); #@lines = fg_xml_to_lines(\%lnmap, @lines); @lines = xml_to_lines(\%lnmap, @lines); #my $txt = join("\n",@lines); #$txt .= "\n"; #outfile("tempxml3.xml",$txt); $max = scalar @lines; prt( "Got $max lines to process...\n"); $inmat = 0; $ln = 0; $names = ""; $inname = 0; foreach $line (@lines) { $ln++; $len = length($line); if ($inmat) { if ($line =~ /^<\/material/) { prt("$names\n") if length($names); prt("$ln: Exit $line\n") if ($dbg1); $inmat = 0; $names = ""; } } else { if ($line =~ /^<material/) { prt("$ln: Entered $line\n") if ($dbg1); $inmat = 1; } } if ($inname) { if ($line =~ /^<\/name/) { $inname = 0; } else { $addit = 0; if ($skipsingles) { if ($len > 1) { $addit = 1; } } else { $addit = 1; } if ($skip_pa) { if ($line =~ /^pa_/) { $addit = 0; } } if ($skip_pc) { if ($line =~ /^pc_/) { $addit = 0; } } if ($skip_cavete) { if ($line =~ /^\^/) { $addit = 0; } } if ($skip_dirt) { if ($line =~ /^dirt_/) { $addit = 0; } } if ($skip_RWY) { if ($line =~ /^RWY_/) { $addit = 0; } } if (($len == 2) && $skipdoubles) { $addit = 0; } if ($skip_Sign) { if ($line =~ /Sign/) { $addit = 0; } } if ($addit) { $names .= "|" if length($names); $names .= $line; } } } else { if ($line =~ /^<name/) { $inname = 1; } } } } } process_in_file($in_file); close_log($outfile,1); exit(0); # eof - fgshowmaterials.pl