test.pl to HTML.

index -|- end

Generated: Sat Oct 12 17:23:20 2013 from test.pl 2013/08/04 5.7 KB. text copy

#!/bin/perl
# test.pl
# AIM: Various 'test'
use strict;
use warnings;
use File::Basename;     # to split path into ($name, $dir) = fileparse($ff); or ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ );
use LWP::Simple;
use IO::File;

my $url = "http://static.fgx.ch/js/OpenLayers-2.12/theme/default/style.css";

sub prt($) { print shift; }

sub fetch_url($$) {
   my ($url,$ra) = @_;
    my $ret = 0;
   prt( "Fetching: $url\n" );
   my $txt = get($url);
   if ($txt && length($txt)) {
      # prt( "$txt\n" );
        @{$ra} = split("\n",$txt);
        $ret = scalar @{$ra};
    } else {
        prt("URL: $url FAILED!\n");
    }
    return $ret;
}

my @arr = ();

#my $cnt = fetch_url($url,\@arr);
#prt("Got $cnt lines...\n");

sub trim_leading($) {
    my ($ln) = shift;
   $ln = substr($ln,1) while ($ln =~ /^\s/); # remove all LEADING space
    return $ln;
}

sub trim_tailing($) {
    my ($ln) = shift;
   $ln = substr($ln,0, length($ln) - 1) while ($ln =~ /\s$/g); # remove all TRAILING space
    return $ln;
}

sub trim_ends($) {
    my ($ln) = shift;
    $ln = trim_tailing($ln); # remove all TRAINING space
   $ln = trim_leading($ln); # remove all LEADING space
    return $ln;
}

sub trim_all {
   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 = trim_ends($ln);
   $ln =~ s/\s{2}/ /g while ($ln =~ /\s{2}/);   # all double space to SINGLE
   return $ln;
}


sub strip_comments($) {
    my $line = shift;
    $line =~ s/(.+);.*$/$1/;
    $line =~ s/(.+)\#.*$/$1/;
    $line = trim_all($line);
    return $line;
}


#my $line1 = '!include "MUI2.nsh" ; comment';
#my $line2 = '!include "MUI2.nsh" # comment';
#my ($nline);
#prt("1: [$line1]\n");
#$nline = strip_comments($line1);
#prt("1: [$nline]\n");
#prt("2: [$line2]\n");
#$nline = strip_comments($line2);
#prt("2: [$nline]\n");

sub space_split2 {
   my ($txt) = shift;
   my $len = length($txt);
   my ($k,$ch,$tag,$incomm,$k2,$nch,$pc,$cc);
   my @arr = ();
   $tag = '';
   $incomm = 0;
    $ch = '';
    $cc = '';
   for ($k = 0; $k < $len; $k++) {
      $ch = substr($txt,$k,1);
        $k2 = $k + 1;
        $nch = ($k2 < $len) ? substr($txt,$k2,1) : "";
      if ($incomm) {
            if ($ch eq $cc) {
                $incomm = 0;
                prt("$k: begin comment with [$cc]\n");
            }
         $tag .= $ch;
            # add 2010/05/05 to avoid say '"zlib">' begin a tag
            if (!$incomm) {
                push(@arr,$tag);
                $tag = '';
            }
      } elsif ($ch =~ /\s/) { # any spacey char
            if (length($tag)) {
                push(@arr, $tag);
                prt("$k: added tag [$tag] on [$ch]\n");
            }
         $tag = '';
      } elsif (($ch =~ /\//)&&($nch eq '>')) { # 04/10/2008, but only if before '>' 24/09/2008 add this as well
         push(@arr, $tag) if (length($tag));
         $tag = $ch; # restart tag with this character
      } else {
         $tag .= $ch;
            if (($ch eq '"')||($ch eq "'")||($ch eq "`")) {
             $incomm = 1;
                $cc = $ch;
                prt("$k: begin comment with [$cc]\n");
            }
      }
   }
   push(@arr, $tag) if (length($tag));
   return @arr;
}


#my $line = 'Abort '."`".'"" Abort ""'."`";
#@arr = space_split2($line);
#my $acnt = scalar @arr;
#prt("Got $acnt array for [$line]...\n");
#foreach my $tmp (@arr) {
#    prt("[$tmp]\n");
#}

sub path_d2u($) {
   my ($du) = shift;
   $du =~ s/\\/\//g;
   return $du;
}


sub get_parent_dir($) {
    my $path = shift;
    my $test = path_d2u($path);
    my ($n,$d) = fileparse($test);
    if ($d =~ /^\.(\\|\/)$/) {
        return $path;
    }
    my @arr = split("/",$d);
    my $len = scalar @arr;
    if ($len == 1) {
        return $d;
    }
    prt("Split [$d] len $len\n");
    foreach $d (@arr) {
        prt("[$d]\n");
    }
    return $arr[-1];
}

sub test_splice2() {
    my $line = "13 57.10393300  009.99280800  57  11670 199    0.0     AAL  AALBORG TACAN";
    $line = trim_all($line);
    my @arr = split(/\s+/,$line);
    my $acnt = scalar @arr;
    my $name = join(' ', splice(@arr,8)); 
    prt("cnt=$acnt [$name]\n");
}

sub test_splice() {
    my $line = "51 12030 BOIGU MULT";
    my @arr = split(/\s+/,$line);
    my $acnt = scalar @arr;
    my $type = $arr[0];
    my $freq = ($arr[1] / 100);
    my $name = join(' ', splice(@arr,2)); 
    prt("cnt=$acnt [$type] [$freq] [$name]\n");
}

sub test_array() {
    my @arr = ();

    $arr[0] = 0;
    $arr[1] = 1;
    $arr[3] = 3;
    my $cnt = scalar @arr;
    prt("Array size = $cnt\n");
    my ($i,$num);
    for ($i = 0; $i < $cnt; $i++) {
        if (defined $arr[$i]) {
            $num = $arr[$i];
            prt("$num ");
        } else {
            prt("($i ND) ");
        }
    }
    prt("\n");
    for ($i = 0; $i < $cnt; $i++) {
        $num = $arr[$i];
        if (defined $num) {
            prt("$num ");
        } else {
            prt("($i ND) ");
        }
    }
    prt("\n");
}

sub test_text() {
    my $txt = "`test -f 'ngettext.c'";
    if ($txt =~ /^`test/) {
        prt("ok\n");
    } else {
        prt("FAILED\n");
    }
}


my $line = 'C:\FG\fgdata\Aircraft\ZLT-NT\ZLT-NT-copilot-set.xml';
#my $tmp = get_parent_dir($line);
#prt("Parent = [$tmp]\n");
test_splice();

# test utf8 encoding
my $positions = new IO::File;
$positions->open('c:\Gtools\perl\temputf8.txt', "w") || die("Cannot open tetmp...txt for writing: $!\n");
print $positions Encode::encode( "utf8", "Clément\n");
$positions->close();
my $val = 123.456;
my $cval1 = sprintf("[%3.3f]",$val);
my $cval2 = sprintf("[%6.3f]",$val);

print "$cval1 $cval2\n";


test_array();

test_text();

# eof

index -|- top