#!/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