This is perl 5, version 24, subversion 1 (v5.24.1) t/50-gh63-encode-response-content.t ........... Possible unintended interpolation of @50 in string at t/50-gh63-encode-r esponse-content.t line 49. t/50-gh63-encode-response-content.t ........... 1/4 Terminating on signal SIGINT(2) Terminating on signal SIGINT(2) Caught SIGINT. Trying to quit ... dmake.exe: Warning: -- dmake.exe: Error code 130, while making 'test_dynamic' Internal Warning: finished pid 12 is not in pq!?Signal SIGINT received, but no signal handler set. Terminare il processo batch (S/N)? s ##

##

 
 
  
 
     
     
          

 
 





 


pippo pluto
 
  
 


##

##

use strict;
use warnings;
use Symbol qw(geniosym);


my $FH = 'scalar'; 
open FH,'>','test.txt' or die;

print "File n. of FH before: ", fileno FH , $/ ;

*FH = geniosym;

# as choroba noted the following 2 statements are not useful.
# for sure I dont understand the docs:
# Symbol::geniosym creates an anonymous IO handle. This can be assigned into an existing glob without affecting the non-IO portions of the glob. 
#
# undef $::{FH}{IO};
# delete $::{FH}{IO}; 

print "File n. of FH after: ",( fileno FH ? fileno FH : '-NA-'),  $/ ;

print "SCALAR slot of FH: ",$FH, $/;



##

##

$n=4; print $n." -- ".(--$n,($n||'no more')).".\n" while $n;

__END__
sub b{' bottle'.($n==1?'':'s').' of beer'}
$w=' on the wall';
$n=99;print$n.b.$w.', '.$n.b.".\nTake one down and pass it around, ".(--$n,($n||'no more').b.$w).".\n\n"while$n;
print"No more".b."$w, no more".b.".\nGo to the store and buy some more, 99".b."$w."


#output on 5.28
98 bottles of beer on the wall, 98 bottles of beer.
Take one down and pass it around, 98 bottles of beer on the wall.
...
1 bottles of beer on the wall, 1 bottles of beer.
Take one down and pass it around, 1 bottle of beer on the wall.

0 bottle of beer on the wall, 0 bottle of beer.
Take one down and pass it around, no more bottles of beer on the wall.

No more bottles of beer on the wall, no more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall.


##

##

# more above but I suppose not so much related but ask me if interested

 wagnerc: sometimes you'd setup ssi for cgi output too!
 that sounds terrifying and insecure
 not terribly
 hobbs: I don't think I've ever in my life been in a situation where I was responsible for deployments and there wasn't anything 'not normal' involved :P
 I remember when that was how you put a counter on your web page :D
 execute a C program.
 sim, CGI and then SSI??
 > execute a C program.
 Hey, people are starting to that again! With webassembly this time, though
 wagnerc: yea, because the adserver stuff was all SSI based
 The Great Wheel turns inexoribly.
 But SSI is how we got PHP. :)
* daxim has quit (Quit: WeeChat 2.3)
 also these days we have people serving up their entire app in a gig of client-side js :(
 i can't wait for WASI to really start getting it's feet on the ground.  it'll make for some really interesting deployment stuff
 WASI?
 https://www.infoq.com/news/2019/04/wasi-wasm-system-interface
 and no that's not an april fools day joke
 Ok cool 'cause wikipediaing it brought me to Wechsler Abbreviated Scale of Intelligence
 Mozilla .NET :D
 wagnerc: basically :)  once it gets further I'm *really* tempted to try to get perl running under it
 honestly webassembly sounds like java or silverlight but "This time it won't have all those security flaws because *we* made it"
 Why haven't you implemented Perl in JavaScript yet??
 wagnerc: someone else beat me to it
 https://webperl.zero-g.net/
 XD
 Will this initiative to run perl under wasm include getting xs modules to run under wasm
 'cause that seems hard
 wasi will be a bit different
 PavelB: that'd be the idea, it should be doable
 I don't know how you can translate arbitrary C into WASM
 The way I see it you'd have to adapt the source of every XS module you want to use
 That doesn't look like a Perl implementation. It looks like a script server.
 http://blog.builtinperl.com/post/5-major-websites-that-use-perl
 wagnerc: it's a port of perl to WASM that then lets you use it as the scripting language for html
 PavelB: you can absolutely do C in WASM, that's kinda the point.  there's a number of system interfaces (i.e. sockets, files, etc.) that need to exist to do any arbitrary stuff, and that's what WASI is intending to do.
 you probably wouldn't get things like mmap and other low-level system stuff but that's not a big deal
* theory has quit (Quit: theory)
 There's C you've written to target WASM specifically, and there's arbitrary C
 they're the same
 WASM doesn't require special casing of things
 What happens if you try to dynamically link a library?
 that's not a C thing, that's a platform thing
 which is the kind of thing that WASI is targeting
 C itself doesn't know a damned thing about linking.



##

##

Global symbol "$VERSION" requires explicit package name (did you forget to declare "my $VERSION"?) at D:/ulisseDUE/perl5.26.64bit/perl/site/lib/Tk/Frame.pm line 16, <__ANONIO__> line 21.
Compilation failed in require at D:/ulisseDUE/perl5.26.64bit/perl/lib/base.pm line 100, <__ANONIO__> line 21.
        ...propagated at D:/ulisseDUE/perl5.26.64bit/perl/lib/base.pm line 109, <__ANONIO__> line 21.
BEGIN failed--compilation aborted at D:/ulisseDUE/perl5.26.64bit/perl/site/lib/Tk/Toplevel.pm line 10, <__ANONIO__> line 21.
Compilation failed in require at D:/ulisseDUE/perl5.26.64bit/perl/lib/base.pm line 100, <__ANONIO__> line 21.
        ...propagated at D:/ulisseDUE/perl5.26.64bit/perl/lib/base.pm line 109, <__ANONIO__> line 21.
BEGIN failed--compilation aborted at D:/ulisseDUE/perl5.26.64bit/perl/site/lib/Tk/MainWindow.pm line 5, <__ANONIO__> line 21.
Compilation failed in require at D:/ulisseDUE/perl5.26.64bit/perl/site/lib/Tk.pm line 192, <__ANONIO__> line 21.
Compilation failed in require at D:/ulisseDUE/pm-cb-Mar2019/lib/PM/CB/GUI.pm line 38, <__ANONIO__> line 21.


##

##

use strict;
use warnings;
use Storable qw(dclone);
use Test::More;

my %nested = (
	a => { b=> 2, c=>3, d=>4},
	e => { f => 6}
);

my %copy1 = %nested;

is_deeply( \%nested,\%copy1, 
		"plain hash copies are equal"
);

my %nested_with_refs = (
	g => 7,
	h => \%nested,
);

my %copy_with_refs = %nested_with_refs;
is_deeply( \%nested_with_refs,\%copy_with_refs, 
		"hash with references copies are equal"
);


my $ref = \%nested_with_refs;
my %ref_copy = %{$ref};


is_deeply( \%nested_with_refs,\%ref_copy, 
		"reference and hash with references copies are equal"
);

# original example:

my %hash = ();
$hash{a}{drinks}=1;
$hash{b}{drinks}=2;

my $p = \%hash;
my %copy = %{ $p };

is_deeply( \%hash,\%copy , 
		"also original example copies are equal"
);

$copy{a}{drinks}=4;
is_deeply( \%hash,\%copy , 
		"also after changing \$copy{a}{drinks} copies are equal, because share the same ref"
);


my $deep_copy_ref = dclone(\%hash);

is_deeply( \%hash, $deep_copy_ref , 
		"dclone copies are equal"
);

$hash{a}{drinks} = 444;


# this now fails
is_deeply( \%hash, $deep_copy_ref , 
		"THIS WILL FAIL: dclone copies are equal"
);
# until..
$$deep_copy_ref{a}{drinks} = 444;
is_deeply( \%hash, $deep_copy_ref , 
		"dclone copies are equal again"
);


done_testing();


##

##

git-client> git request-pull master https://github.com/LorenzoTa/Win32-Backup-Robocopy

warn: No match for commit 9b2300bc640ab759adeac6ffb206d82c23d0d5d6 found at https://github.com/LorenzoTa/
Win32-Backup-Robocopy
warn: Are you sure you pushed 'HEAD' there?
The following changes since commit d7473d06cfb9b2043877a430563b90aa3ec7a0b2:

  used module bkpscenario in test 09 (2018-12-30 16:00:57 +0100)

are available in the Git repository at:

  https://github.com/LorenzoTa/Win32-Backup-Robocopy

for you to fetch changes up to 9b2300bc640ab759adeac6ffb206d82c23d0d5d6:

  pod for restore (2019-01-04 21:54:59 +0100)

----------------------------------------------------------------
LorenzoTa (15):
      some clean
      some clean
      restore mode 1
      more restore
      more restore 2
      history restore
      changed return val from restore
      typos and _validate_upto
      added test validate_upto
      added 11-restorehistory.t
      last line
      fixed restore upto
      used check_last_line in test 10
      fixed verbose restore upto
      pod for restore

 lib/Win32/Backup/Robocopy.pm | 273 +++++++++++++++++++++++++++++++++----------
 t/02-run.t                   |   4 +-
 t/03-job.t                   |   4 +-
 t/04-runjobs.t               |   4 +-
 t/05-writeconf.t             |   4 +-
 t/06-loadconf.t              |   4 +-
 t/07-listjobs.t              |   4 +-
 t/09-runjobs-ranges.t        |   4 +-
 t/10-restore.t               | 120 +++++++++++++++++++
 t/11-restorehistory.t        | 137 ++++++++++++++++++++++
 t/bkpscenario.pm             |  35 ++++--
 11 files changed, 512 insertions(+), 81 deletions(-)
 create mode 100644 t/10-restore.t
 create mode 100644 t/11-restorehistory.t


##

##

C:\Users\io\gittest2>git status
On branch master
nothing to commit, working tree clean

C:\Users\io\gittest2>git checkout newbr
Switched to branch 'newbr'

C:\Users\io\gittest2>git status
On branch newbr
nothing to commit, working tree clean

C:\Users\io\gittest2>echo TRE >> file1

C:\Users\io\gittest2>git status
On branch newbr
Changes not staged for commit:
  (use "git add ..." to update what will be committed)
  (use "git checkout -- ..." to discard changes in working directory)

        modified:   file1

no changes added to commit (use "git add" and/or "git commit -a")

C:\Users\io\gittest2>git checkout master
error: Your local changes to the following files would be overwritten by checkout:
        file1
Please commit your changes or stash them before you switch branches.
Aborting


####################
# OK
####################

C:\Users\io\gittest2>git status
On branch newbr
Changes not staged for commit:
  (use "git add ..." to update what will be committed)
  (use "git checkout -- ..." to discard changes in working directory)

        modified:   file1

no changes added to commit (use "git add" and/or "git commit -a")

C:\Users\io\gittest2>git commit -a -m "third line"
[newbr 3573539] third line
 1 file changed, 1 insertion(+)

C:\Users\io\gittest2>git checkout master
Switched to branch 'master'

C:\Users\io\gittest2>echo FROM MASTER >> file1

C:\Users\io\gittest2>git commit -a -m "from master"
[master d55d746] from master
 1 file changed, 1 insertion(+)

C:\Users\io\gittest2>git checkout newbr
Switched to branch 'newbr'

C:\Users\io\gittest2>git status
On branch newbr
nothing to commit, working tree clean

C:\Users\io\gittest2>echo FROM NEWBR 1 >> file1

C:\Users\io\gittest2>git status
On branch newbr
Changes not staged for commit:
  (use "git add ..." to update what will be committed)
  (use "git checkout -- ..." to discard changes in working directory)

        modified:   file1

no changes added to commit (use "git add" and/or "git commit -a")

C:\Users\io\gittest2>git commit -a -m "from newbr"
[newbr b774b92] from newbr
 1 file changed, 1 insertion(+)

C:\Users\io\gittest2>git checkout master
Switched to branch 'master'


# ok again

C:\Users\io\gittest2>git checkout master
Switched to branch 'master'

C:\Users\io\gittest2>echo FROM MASTER 1 >> file2

C:\Users\io\gittest2>git add file2

C:\Users\io\gittest2>git commit -a -m"master 1"
[master 489b9ee] master 1
 1 file changed, 1 insertion(+)
 create mode 100644 file2

C:\Users\io\gittest2>type file2
FROM MASTER 1

C:\Users\io\gittest2>echo FROM MASTER 2 >> file2

C:\Users\io\gittest2>git commit -a -m"master 2"
[master f9721b9] master 2
 1 file changed, 1 insertion(+)

C:\Users\io\gittest2>type file2
FROM MASTER 1
FROM MASTER 2

C:\Users\io\gittest2>git branch new

C:\Users\io\gittest2>git checkout new
Switched to branch 'new'

C:\Users\io\gittest2>type file2
FROM MASTER 1
FROM MASTER 2

C:\Users\io\gittest2>echo FROM NEW 1 >> file2

C:\Users\io\gittest2>echo FROM NEW 2 >> file2

C:\Users\io\gittest2>git commit -a -m"new 1"
[new dc62b5e] new 1
 1 file changed, 2 insertions(+)

C:\Users\io\gittest2>git checkout master
Switched to branch 'master'

C:\Users\io\gittest2>type file2
FROM MASTER 1
FROM MASTER 2

C:\Users\io\gittest2>git checkout new
Switched to branch 'new'

C:\Users\io\gittest2>type file2
FROM MASTER 1
FROM MASTER 2
FROM NEW 1
FROM NEW 2

C:\Users\io\gittest2>git checkout master
Switched to branch 'master'

C:\Users\io\gittest2>echo FROM MASTER 3 >> file2

C:\Users\io\gittest2>type file2
FROM MASTER 1
FROM MASTER 2
FROM MASTER 3

C:\Users\io\gittest2>git checkout new
error: Your local changes to the following files would be overwritten by checkout:
        file2
Please commit your changes or stash them before you switch branches.
Aborting

C:\Users\io\gittest2>git commit -a -m"master 2"
[master 73a0135] master 2
 1 file changed, 1 insertion(+)

C:\Users\io\gittest2>git checkout new
Switched to branch 'new'

C:\Users\io\gittest2>type file2
FROM MASTER 1
FROM MASTER 2
FROM NEW 1
FROM NEW 2

C:\Users\io\gittest2>




##

##

general>check_perl_distro -e "use B::Xref; print $B::Xref::VERSION,$/;"
 | 1.07
[OK] D:\ulisseDUE\perl5.28.32bit\perl\bin\perl.exe
 | 1.05
[OK] D:\ulisseDUE\perl5.20.64bit\perl\bin\perl.exe
 | 1.05
[OK] D:\ulisseDUE\perl5.22.64bit\perl\bin\perl.exe
 | 1.05
[OK] D:\ulisseDUE\perl5.24.64bit\perl\bin\perl.exe
 | 1.06
[OK] D:\ulisseDUE\perl5.26.64bit\perl\bin\perl.exe
 | 1.06
[OK] D:\ulisseDUE\perl-5.26.64bit-PDL\perl\bin\perl.exe


##

##

general>check_perl_distro -MO=Xref,-r,-d tst_b_xref.pl | grep row

tst_b_xref.pl syntax OK
 | tst_b_xref.pl         (main)           7 (lexical)       @ row              used
 | tst_b_xref.pl         (main)           9 (lexical)       @ row              intro
[OK] D:\ulisseDUE\perl5.28.32bit\perl\bin\perl.exe

tst_b_xref.pl syntax OK
 | tst_b_xref.pl         (main)           7 (lexical)       @ row              used
 | tst_b_xref.pl         (main)           9 (lexical)       @ row              intro
[OK] D:\ulisseDUE\perl5.20.64bit\perl\bin\perl.exe

tst_b_xref.pl syntax OK
 | tst_b_xref.pl         (main)           7 (lexical)       @ row              used
 | tst_b_xref.pl         (main)           9 (lexical)       @ row              intro
[OK] D:\ulisseDUE\perl5.22.64bit\perl\bin\perl.exe

tst_b_xref.pl syntax OK
 | tst_b_xref.pl         (main)           7 (lexical)       @ row              used
 | tst_b_xref.pl         (main)           9 (lexical)       @ row              intro
[OK] D:\ulisseDUE\perl5.24.64bit\perl\bin\perl.exe

tst_b_xref.pl syntax OK
 | tst_b_xref.pl         (main)           7 (lexical)       @ row              used
 | tst_b_xref.pl         (main)           9 (lexical)       @ row              intro
[OK] D:\ulisseDUE\perl5.26.64bit\perl\bin\perl.exe

tst_b_xref.pl syntax OK
 | tst_b_xref.pl         (main)           7 (lexical)       @ row              used
 | tst_b_xref.pl         (main)           9 (lexical)       @ row              intro
[OK] D:\ulisseDUE\perl-5.26.64bit-PDL\perl\bin\perl.exe
                                                                                                                        


##

##

perl -MList::Util="first" -E "@c[0..123456789]=(0..123456789);say for grep{$e=eval $_;$c[$e]=undef if $e >=0;$h{$e}++;eval $_ == 100} glob '{-,}'.join '{+,-,}',1..9;END{ say for (sort{ $h{$b}<=>$h{$a}}grep{$_>=0}keys %h)[0], first{defined $_}@c}"

Out of memory!
panic: gen_constant_list JMPENV_PUSH returned 2 at -e line 1.


##

##

#!/usr/bin/perl
use warnings;
use strict;

use Encode;

sub decode {
    require Encode;
    Encode::decode('UTF-8', shift);
}

# output

Prototype mismatch: sub main::decode ($$;$) vs none at test_decode01.pl line 26.
Subroutine decode redefined at test_decode01.pl line 23.
abc



##

##

#
# $Id: Encode.pm,v 2.92 2017/07/18 07:15:29 dankogai Exp dankogai $
#
package Encode;
use strict;
use warnings;
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
our $VERSION;
BEGIN {
    $VERSION = sprintf "%d.%02d", q$Revision: 2.92 $ =~ /(\d+)/g;
    require XSLoader;
    XSLoader::load( __PACKAGE__, $VERSION );
}

use Data::Dump; dd caller(1);

...



##

##

do {
  my $f = undef;
  (
    "main",
    "D:/ulisse/perl5.26.64bit/perl/lib/Encode.pm",
    0,
    "main::BEGIN",
    1,
    $f,
    $f,
    $f,
    2018,
    "UUUUUUUUUUUUUUUUU\5",
    $f,
  );
}
Prototype mismatch: sub main::decode ($$;$) vs none at test_decode01.pl line 26.
Subroutine decode redefined at test_decode01.pl line 23.
abc


##

##

perl -MMath::Prime::Util::GMP=":all" -E "@p=grep{is_prime($_)}1..1000; say qq($p[$_] = ),$p[$_]-($p[$_-1]-1),
(is_prime($p[$_]-$p[$_-1]-1)?' prime':'')for 1..$#p"


##

##

use warnings;
use strict;

use Win32::Console qw(GENERIC_READ GENERIC_WRITE);
use Data::Dump qw(dd);

my $con_current = Win32::Console->new(GENERIC_READ | GENERIC_WRITE);
$con_current or die 'new Win32::Console failed';

my ($left, $top, $right, $bottom) = $con_current->Window;
print "Dimensions (left top right bottom):",qq($left, $top, $right, $bottom \n);

my $rect = $con_current->ReadRect($left, $top, $right, $bottom);
$rect or die 'read Win32::Console failed';

#$rect =~ s{ \0\a\0  } ''xmsg;
#$rect =~ s{ [ ]+ \z } ''xmsg;

#dd $rect;
print qq{======\nBefore writing anything from Win32.:Console\n======\n};

$con_current->WriteRect($rect,$left, $top, $right, $bottom )or die 'write Win32::Console failed'; 

print "dd of \$rect: "; dd $rect;

######################################################################
use strict;
use warnings;

use GD;

my $file = $ARGV[0];
die "Please feed a jpg file.." unless -e $file;

my $orig_gd = GD::Image->new($file);

my $photo_ratio = 0.3;

my $small_w = int($orig_gd->width  * $photo_ratio);
my $small_h = int($orig_gd->height * $photo_ratio);

draw_photo ($file);

################################################################################
sub draw_photo {


  my $file_path = shift;
  # create the resized but still empty GD image
  my $resized = GD::Image->new($small_w,$small_h);
  # copy from source into resized on
     $resized->copyResampled($orig_gd,0,0,0,0,
              $small_w,
              $small_h,
              $orig_gd->width,
              $orig_gd->height);

  # save
  open my $out, '>', time.'.jpg' or die "unable to open for write";
  binmode $out;
  print $out $resized->jpeg or die "unable to write jpg data!";
  close $out;
}


##

##

use strict;
use warnings;

@ARGV = grep {length $_} map {my @ar = split /\s/; shift @ar,"@ar"} map {split /\n/} <##


#output preceded by pipe sign, Perl version below
general>check_perl_distro -e "opendir $D, '.' or die $!; print !! fileno $D || !! $!;"
 |
[OK] C:\ulisse\strawberry\perl\bin\perl.exe
 |
[OK] C:\ulisse\straw64\perl\bin\perl.exe
 |
[OK] C:\ulisse\straw5.20-32b\perl\bin\perl.exe
 | 1
[OK] C:\ulisse\strP5.22-32\perl\bin\perl.exe



####

# PICK ONE OF TWO OPEN OPTIONS BELOW
  #1#print STDERR "Option 1\n"; open($fh1, '>&', $fhSave)                     or die "Can't restore fh1";
  #2#print STDERR "Option 2\n";open($fh1, '>', \ substr($s1, length($s1)) )  or die "Can't restore fh1";



####

#!perl
use strict;
use warnings;
              use Encode;
use LWP::Simple;
use XML::Twig;

my $url = 'http://www.paginebianche.it/ricerca?qs='.($ARGV[0] or 'Discepoli');
my $t = XML::Twig->new();             #keep_encoding=>1
my $html = get ($url);

               #$html = encode('UTF-8', $html);
               # whit the line above i get:
               # not well-formed (invalid token) at line 3, column 549, byte 763 at C:/perl/vendor/lib/XML/Parser.pm line 187 
               # without it i got:
               # Cannot decode string with wide characters at C:/ulisse/strawberry/perl/lib/Encode.pm line 196.

$t->parse_html ($html);


####

#!perl
use strict;
use warnings;
use Data::Dumper;
$|++;

use Term::Readline;    #thanks http://perlmonks.org/?node_id=940134
$ENV{TERM} ='';
my $term = Term::ReadLine->new('Package explorator');



my %cmds = (
    'pkg' => sub {
        print "Enter a package name:\n";
        my $pkg = ;
        chomp $pkg;
        print "Enter some code in package $pkg.\nAt the end insert CRTL-Z on a empty line.\n";
        my @in = ;

        my $to_eval = "package $pkg {\n".(join "\n\t",@in)."}\n";
        print "DEBUG:\n$to_eval\n\n";
        {
          local $@;
          eval "$to_eval";
          print "\n\nERROR:$@\n" if $@;
        }

        dump_symbols_of_package($pkg);
    },
    'dump' => sub {
        my $pkg = shift;
        dump_symbols_of_package($pkg);
    },
    'inspect' => sub {
        my ($pkg,$name,$slot) = @_;
        unless ($pkg && $name && $slot){
            print "Please feed a package, a name and a slot.\n";
            return;
        }
        inspect_slot ($pkg,$name,$slot);
    },
);

&user_input;

################################################################################
sub user_input {
    $term->Attribs->{completion_function} = sub {
        my $txt = shift;
        return grep { /^$txt/i } sort keys %cmds;
    };
    my $in;
    while ( defined( $in = $term->readline('Package Explorer>') ) ) {
        chomp($in);
        $in =~ s/^\s+//;
        my ( $cmd, @arg ) = split /\s+/, $in;
        next if !$cmd;
        ##
    if ( $cmd eq 'q' or $cmd eq 'x' ) { exit }    #?
                 #elsif ($in eq 'r'or $in eq 'b') {bench}

    elsif ( exists $cmds{$cmd} ) { $cmds{$cmd}->(@arg) }

    else { print "WARNING Command '$in' not recognized.\n"; next; }
    }

}


####

use 5.10.0;
use warnings;
use strict;
use LWP::UserAgent;

## switch to a maintained (more performant?) module
use XML::Twig;

use Data::Peek;
##### force the dump of $config, only for this test
my $opt_v = 6;

my $ua = LWP::UserAgent->new (
    max_redirect => 2,
    agent        => "Opera/25.00 opera 25",
    parse_head   => 0,
    cookie_jar   => {},
    );
###NEW THINGS FROM HERE ON
###
my $client;
my $times;
my $downld;
my $upld;
#new
my $ignore_ids;

my %list; ## a global instead my %list =  get_servers (); at line 385
my $config={};## a global


get_config_and_servers_Twig();

## SAME TEST BUT INVERTED ASSIGNMENT
$config->{"client"} = $client   or die "Config saw no client\n";
$config->{"times"} = $times   or die "Config saw no times\n";
$config->{"download"} = $downld or die "Config saw no download\n";
$config->{"upload"} = $upld  or die "Config saw no upload\n";



$config->{"server-config"}{"ignoreids"} = $ignore_ids  or die "Config saw no ignore ids\n";


$opt_v > 5 and DDumper $config;


### ############################################################################

sub get_config_and_servers_Twig
{
    my $url = "http://www.speedtest.net/speedtest-config.php";
    my $rsp = $ua->request (HTTP::Request->new (GET => $url));
    $rsp->is_success or die "Cannot get config: ", $rsp->status_line, "\n";

    ##
    my $twig_config=XML::Twig->new(
          twig_handlers =>
          {
            'settings/client' => sub { map {$$client{$_} = $_[1]->att($_)}  qw/ip isp ispdlavg isprating ispulavg lat loggedin lon rating/},
            # times seems not used by your program!!
            'settings/times' => sub { map {$$times{$_} = $_[1]->att($_)}  qw/dl1 dl2 dl3 ul1 ul2 ul3/},
            'settings/download' => sub { map {$$downld{$_} = $_[1]->att($_)}  qw/initialtest mintestsize testlength threadsperurl/},
            'settings/upload' => sub { map {$$upld{$_} = $_[1]->att($_)}  qw/initialtest maxchunkcount maxchunksize mintestsize ratio testlength threads threadsperurl/},
            #
            'settings/server-config' => sub { $ignore_ids = $_[1]->att('ignoreids') },
          },
    );

    $twig_config->parse( $rsp->content );


    # now get_servers
    
    my $url_servers = "http://www.speedtest.net/speedtest-servers-static.php";
    my $rsp_servers = $ua->request (HTTP::Request->new (GET => $url_servers));
    # ATTENTION the die was die "Cannot get config: " AND NOT get servers..
    $rsp_servers->is_success or die "Cannot get servers ", $rsp_servers->status_line, "\n";
    my $twig_servers=XML::Twig->new(
          twig_handlers =>
          {
             'settings/servers/server' =>
                  sub {  $list{$_[1]->att('id')}  = { map {$_=>$_[1]->att($_)} qw/cc country lat lon name sponsor url url2/ }  },
          },

    );
    $twig_servers->parse( $rsp_servers->content );

    # HERE IS TOO SOON.....$opt_v > 5 and DDumper $config;##was $xml->{settings}
    #return $xml->{settings};
    } # get_config_and_servers_Twig



####

#!perl
use strict;
use warnings;
#use Term::ReadLine;   ##http://bvr.github.io/2010/11/term-readline/

BEGIN { $ENV{PERL_RL}="Perl";$ENV{TERM} = 'not dumb' if $^O eq 'MSWin32';}
$\="\n";
use Term::ReadLine;
my $term=Term::ReadLine->new("test");
print $term->ReadLine;
print $term->Attribs;
use Data::Dump::Streamer;
$term->Attribs->{completion_function} = sub {
    my ($text, $line, $start) = @_;
    return grep { /^$text/i } (qw(
            SELECT INSERT UPDATE DELETE FROM WHERE AS IN ASC DESC
        ),'ORDER BY');
};
#foreach my $k (keys $term->Attribs){print "$k ${$term->Attribs}{$k}\n"}
#exit;
#Dump %{$term->Attribs};exit;
my %cmds = (alloid=>1,ammoid=>2);

   # THIS WORKS
   #&readline::rl_basic_commands(keys %cmds);
   # THE FOLLOWING CHECK DOES NOT WORK
   #if (exists &readline::rl_basic_commands){print "BEFORE WHILE EXISTS\n"; &readline::rl_basic_commands(keys %cmds);}

while ( defined ( $_ = $term->readline( '>') ) ) {
     print "$_\n";
}
continue{
   # THIS CHECK WORKS INDEED!
   if (exists &readline::rl_basic_commands){print "IN CONTINUE EXISTS\n"; &readline::rl_basic_commands(keys %cmds);}
}


####

#!perl
use strict;
use warnings;       use Data::Dump::Streamer;
use Term::ReadLine; # CPANnn would be impossible without a big ABuse of Data::Dump::Streamer
$ENV{TERM}=undef;   # TAB completion made possible on win32 via Term::Readline with TERM=
my ($ua,$cpanfh);   # ugly again? no! UserAgent. need to be here before BEGIN is found,the file handle for cpan data too
BEGIN{
  local $@;
  eval{ require LWP::UserAgent; };
  if ($@){print "WARNING: no LWP::UserAgent support!"}
  if ($@ and !$ARGV[0]){die "FATAL: no filename as argument nor LWP::UserAgent support!\n"}
  $ua = LWP::UserAgent->new;
  my $filename = defined $ARGV[0] ? $ARGV[0] : '02packages.details.txt';  # this must go inside or assignment is not run
  if (!$ARGV[0]){ print "Downloading $filename, please wait..\n";
                  $ua->get('http://www.cpan.org/modules/'.$filename,':content_file'=>$filename) }
  open $cpanfh,'<',$filename or die "FATAL: unable to open '$filename' for reading!\n";
}
my $term = Term::ReadLine->new('CPAN namespace navigator');
my $cpan = {'.'=>'CPAN'};       # the main cpan hasref, container of all namespaces
my $skiprx = qr/^[\.\+]{1,2}$/; # regex used to skip secret hash keys: . .. + ++ (last not used really)
my $pagination = 20;            # used to divide in screenfulls the readme files
my @infos = "\nINFO:\n\n";      # infos about the file and help too
                                # now feed @infos with headers from file
while (<$cpanfh>){print "Processing data, please wait..\n" and last if /^$/;push @infos, $_}
push @infos, $_ for "\n\n","USAGE: $0 [02packages.details.txt]\n\nNAVIGATION:\n\n",
      ".  simple list of contained namespaces\n",".. move one level up\n","+  detailed list of contained namespaces\n",
      "*  read the readme file of current namespace\n", "** download the current namespace's package\n",
      "?  print this help\n","\nTAB completion enabled on all sub namespaces\n","$0 by Discipulus as found at perlmonks.org\n\n";
while (<$cpanfh>){               # main extrapolation loop
        chomp;                   # AA::BB::CC  0.01 D/DI/DISCIPULUS/AA-BB-CC-0.001.tar.gz
        my @fields = split /\s+/;# split namespaces, version, partial path
        my @names = split /::/, $fields[0];# split namespace in AA BB CC
        my @ancestors = @names;
        pop @ancestors;          # @ancestors are @names less last element
        eval '$cpan->{\''.                    # start of cpan container; it ends before next = sign
              (join '\'}{\'', @names).'\'} ='.# expand names and vivifies BECAUSE there is an assignment
               '{'.                           # hasref start
                  '"."=>$names[-1],'.         # hasref . is name and .. is a ref to father
                  '".."=> \%{$cpan'.(defined $ancestors[0] ?'->{\''.(join '\'}{\'',  @ancestors ).'\'}':'').'},'.
                  '"+"=> [$fields[1],$fields[2]],'. # hashref + is used for version and author path array
                '}; ';                        # hashref end
}Dump $cpan;
my $current = \%$cpan; # the current hashref namespace starts at top level of the hash
    &header($current); # first time header
my @cur_names;         # take track of namespaces and, if empty, tell us we are at top level
    &readline::rl_basic_commands(@{&autocompletes}); #first time autocompletes filling

while ( defined ( $_ = $term->readline( (join '::',@cur_names).'>') ) ) {
    /^$/ ? next : chomp;
    s/\s+//g;
    if (exists $$current{$_} and $_ !~ $skiprx) {
        $current = \%{$$current{$_}};
        push @cur_names, $_;
        next;
    }
    elsif($_ eq '.'){ # . -> ls
          print "$_\n" for grep $_ !~ $skiprx, sort keys %$current;
    }
    elsif($_ eq '+'){ # + -> ls -l
          foreach my $k(grep $_ !~ $skiprx, sort keys %$current) {
                  print  "$k\t", ${$current->{$k}{'+'}}[0] ? join "\t", @{$current->{$k}{'+'}} : "--CONTAINER NAMESPACE--","\n";
          }
    }
    elsif($_ eq '..'){# .. -> cd ..
        #$current =  ref $current->{'..'} eq 'HASH' ? \%{$current->{'..'}}: \%$cpan;
        $current =  \%{$current->{'..'}}  ;
        pop @cur_names;
    }
    elsif($_ eq '*'){ # * -> dump the readme
          unless ($ua){print "WARNING: no LWP::UserAgent support!\n"; next;}
          if (defined $$current{'+'}->[0]) {
                (my $url = 'http://www.cpan.org/authors/id/'.$$current{'+'}->[1]) =~s/\.tar\.gz/\.readme/ ;
                my $line_count;
                foreach my $line (split "\n",$ua->get($url)->content()) {
                    ++$line_count;
                    print "$line_count:".$line."\n" ;
                    if ($line_count % $pagination == 0){print "-- press Enter to continue..";while (){last if $_ }}
                }
          }
    }
    elsif($_ eq '**'){# ** -> download the package
          unless ($ua){print "WARNING: no LWP::UserAgent support!\n"; next;}
          if (defined $$current{'+'}->[0]) {
                (my $gzfile = 'http://www.cpan.org/authors/id/'.$$current{'+'}->[1]) =~s{.+/}{} ;
                 my $resp = $ua->get('http://www.cpan.org/authors/id/'.$$current{'+'}->[1],':content_file'=>$gzfile);
                 print $resp->is_success ? "OK: download of '$gzfile' succesfull\n" : "WARNING: $resp->status_line!\n";
          }
    }
    elsif($_ eq '?'){ print for @infos }# * -> shows infos and help
    else{print "WARNING: '$_' command not found!\n"; next}
}
continue{
      &header($current);
      &readline::rl_basic_commands(@{&autocompletes});
}
sub autocompletes{scalar @cur_names > 0 ? return [grep $_ !~ $skiprx,sort keys %$current] : return [grep $_ !~ $skiprx, keys %$cpan]; }
sub header {
    my $hr = shift;
    print "\n",(join '::',@cur_names or 'CPAN'),($$hr{'+'}->[0] ? "\t$$hr{'+'}->[0]\t$$hr{'+'}->[1]" : ""),
          " has ",(scalar@{[grep $_ !~ $skiprx, keys %$hr]})," namespaces\n";
}


####

#!perl
my $ua;
BEGIN{
  my $ua;
  local $@;
  eval{
        require LWP::UserAgent;
        #LWP::UserAgent->import;
        $ua = LWP::UserAgent->new;
  };
  if ($@){warn "WARNING: no LWP::UserAgent support!"}
  if ($@ and !$ARGV[0]){die "FATAL: no filename as argoument nor LWP::UserAgent support!\n"}
  eval{
        require Term::ReadKey;
        #Term::ReadKey->import;
        #$ua = LWP::UserAgent->new;
  };
  if ($@){warn "WARNING: no Term::ReadKey support!"}
  #our $ua = LWP::UserAgenta->new;
}
my $ua;
print $ua;
#exit;
use strict;
use warnings;
use feature qw (say);
$|=1; use Diagnostics;  use Data::Dumper; use Data::Dump::Streamer;
my $cpan = {'.'=>'CPAN'}; #_=>'',__=>''
my $skiprx = qr/^[\.\+]{1,2}$/;
#our @names;
&grow_tree;

sub grow_tree {
    while (){
        chomp;
        my @fields = split /\s+/;#say "@fields";
        my @names = split /::/, $fields[0];#say "names($#names): @names";
        my $cur;
        my @ancestors = @names;
        pop @ancestors;
        eval '$cpan->{'.                   # start od cpan container
              (join '}{', @names).'} ='.   # expand names and vivifies because there is assignment
               '{'.                        # hasref start
                  '"."=>$names[-1],'.
                  '".."=> \%{$cpan'.(defined $ancestors[0] ?'->{'.(join '}{', @ancestors ).'}':'').','.'},'.
                  '"+"=> [$fields[1],$fields[2]],'.
              '}; '; # hashref end


    }
    Dump($cpan);
}

my $current = \%$cpan;&header($current);
my @cur_names;
while(){
    chomp;

    if (exists $$current{$_} and $_ !~ $skiprx) {

       $current = \%{$$current{$_}};
       push @cur_names, $_;
       next;
    }
    # . -> ls
    elsif($_ eq '.'){ say for grep $_ !~ $skiprx, keys %$current;

    }
    # + -> ls -l
    elsif($_ eq '+'){
                      foreach my $k(grep $_ !~ $skiprx, keys %$current) {
                               print  "$k\t", ${$current->{$k}{'+'}}[0] ? join "\t", @{$current->{$k}{'+'}} : "--CONTAINER NAMESPACE--","\n";
                      }
    }
    # .. -> cd ..
    elsif($_ eq '..'){
        ref $current->{'..'} eq 'HASH' ? say "ok father defined for $current->{'.'}" : say "WARN no father defined";
        #$current = \%{$current->{__}}||\%$cpan;
        $current =  ref $current->{'..'} eq 'HASH' ? \%{$current->{'..'}}: \%$cpan;
        pop @cur_names;

    }
    # * -> dump the readme
    elsif($_ eq '*'){ #foreach my $k (keys %$current) {next if $k=~$skiprx;print "$k @{$current->{$k}{'+'}}\n"}
          if (defined $$current{'+'}->[0]) {
                print "$$current{'.'} ".
                 ($$current{'+'}->[0]||'').#($$current{'+'}->[0] ? $$current{'+'}->[0] : '').
                "\n";
                my $url = 'http://www.cpan.org/authors/id/'.$$current{'+'}->[1];
                $url =~s/\.tar\.gz/\.readme/;
                print "URL: $url\n";
                print LWP::UserAgent->new->get($url)->content()   ;
          }
    }

    else{next}
}
continue{&header($current);
  #print "CURRENT: ",$$current{_},"\n";
}

sub header {
    my $hr = shift;
    print "-" x 35,"\n";
    #print "# CURRENT: ",($$hr{'.'}or 'EMPTY')," has ",(scalar@{[grep !$skiprx, keys %$hr]} or 'no')," namespaces\n";
    print +(join '::',@cur_names or 'CPAN'),
          ($$hr{'+'}->[0] ? "\t$$hr{'+'}->[0]" : "\t"),
          "\thas ",(scalar@{[grep $_ !~ $skiprx, keys %$hr]})," namespaces\n";
    #print "#" x 35,"\n";
}

__DATA__
ABI                                 1.0  M/MA/MALAY/ABI-1.0.tar.gz
A                           0.5  I/ID/IDOPEREL/Abilities-0.5.tar.gz
A::BB                0.5  I/ID/IDOPEREL/Abilities-0.5.tar.gz
A::CC                  0.2  I/ID/IDOPEREL/Abilities-0.2.tar.gz
A::CC::DD             0.2  I/ID/fake/Abilities-0.2.tar.gz
XX::ZZ::YY          0.1 I/jhsjkha


####

#!perl
use strict;
use warnings;
use feature qw (say);
$|=1; use Diagnostics;  use Data::Dumper; use Data::Dump::Streamer;
my $cpan = {'.'=>'CPAN'}; #_=>'',__=>''
my $skiprx = qr/^\.{1,2}|\+$/;
#our @names;
&grow_tree;

sub grow_tree {
    while (){
        chomp;
        my @fields = split /\s+/;#say "@fields";
        my @names = split /::/, $fields[0];#say "names($#names): @names";
        my $cur;
        my @ancestors = @names;
        pop @ancestors;
        eval '$cpan->{'.                   # start od cpan container
              (join '}{', @names).'} ='.   # expand names and vivifies because there is assignment
               '{'.                        # hasref start
                  '"."=>$names[-1],'.
                  '".."=> \%{$cpan'.(defined $ancestors[0] ?'->{'.(join '}{', @ancestors ).'}':'').','.'},'.
                  '"+"=> [$fields[1],$fields[2]],'.
              '}; '; # hashref end


    }
    Dump($cpan);
}

my $current = \%$cpan;&header($current);
while(){
    chomp;

    if (exists $$current{$_} and $_ !~ $skiprx) {

       $current = \%{$$current{$_}};

    }
    elsif($_ eq '.'){ say for grep !$skiprx, keys %$current;

    }
    elsif($_ eq '..'){
        ref $current->{'..'} eq 'HASH' ? say "ok father defined for $current->{'.'}" : say "WARN no father defined";
        #$current = \%{$current->{__}}||\%$cpan;
        $current =  ref $current->{'..'} eq 'HASH' ? \%{$current->{'..'}}: \%$cpan;

    }
    elsif($_ eq '+'){ print join ' ', $current->{'.'},@{$current->{'+'}},"\n" } #or abstract?
    elsif($_ eq '*'){ foreach my $k (keys %$current) {next if $k=~$skiprx;print "$k @{$current->{$k}{'+'}}\n"} } #or abstract?
    else{next}
}
continue{&header($current);
  #print "CURRENT: ",$$current{_},"\n";
}

sub header {
    my $hr = shift;
    print "#" x 35,"\n";
    print "# CURRENT: ",$$hr{'.'}," has ",(scalar@{[grep !$skiprx, keys %$hr]})," namespaces\n";
    print "#" x 35,"\n";
}

__DATA__
ABI                                 1.0  M/MA/MALAY/ABI-1.0.tar.gz
A                           0.5  I/ID/IDOPEREL/Abilities-0.5.tar.gz
A::BB                0.5  I/ID/IDOPEREL/Abilities-0.5.tar.gz
A::CC                  0.2  I/ID/IDOPEREL/Abilities-0.2.tar.gz
A::CC::DD             0.2  I/ID/fake/Abilities-0.2.tar.gz
XX::ZZ::YY          0.1 I/jhsjkha
#!perl
use strict;
use warnings;
use feature qw (say);
$|=1; use Diagnostics;  use Data::Dumper; use Data::Dump::Streamer;
my $cpan = {'_'=>'CPAN'}; #_=>'',__=>''
#our @names;
&grow_tree;

sub grow_tree {
    while (){
        chomp;
        my @fields = split /\s+/;#say "@fields";
        my @names = split /::/, $fields[0];#say "names($#names): @names";
        my $cur;
        my @ancestors = @names;
        pop @ancestors;
        #print "for '",(join '::',@names),"' ancestor is ",( $ancestors[$#ancestors]?(join '::',@ancestors) : 'CPAN' ),"\n";
        #print "\t\t-->\$cpan",(defined $ancestors[0] ?'{'.(join '}{', @ancestors ).'}':''),"\n";
        eval '$cpan->{'.(join '}{', @names).'} = {_=>$names[-1],__=> \%{$cpan'.(defined $ancestors[0] ?'->{'.(join '}{', @ancestors ).'}':'').'}' .'}; ';
        #print "\n-------------\n-------------\n";
    }
    Dump($cpan);
}

my $current = \%$cpan;&header($current);
while(){
    chomp;
    #say +( defined $$current{_} ?  $$current{_} : 'CPAN')," has ",(scalar@{[grep !/^_{1,2}$/, keys %$current]})," namespaces\n";
    #print '#' x 34,"\nCURRENT",(Dump $current),"\n",'#' x 34,"\n";
    if (exists $$current{$_} and $_ !~ /^_{1,2}$/) {

       $current = \%{$$current{$_}};
         &header($current);
    }
    elsif($_ eq '_'){ say for grep !/^_{1,2}$/, keys %$current;  &header($current);}
    elsif($_ eq '__'){
        ref $current->{__} eq 'HASH' ? say "ok father defined for $current->{_}" : say "WARN no father defined";
        #$current = \%{$current->{__}}||\%$cpan;
        $current =  ref $current->{__} eq 'HASH' ? \%{$current->{__}}: \%$cpan;
        &header($current);
    }
    else{next}
}
#continue{
 #say +( defined $$current{_} ?  $$current{_} : 'CPAN')," has ",(scalar@{[grep !/^_{1,2}$/, keys %$current]})," namespaces\n";
    #print '#' x 34,"\nCURRENT",(Dump $current),"\n",'#' x 34,"\n";
#}

sub header {
    my $hr = shift;
    #Dump $hr;
    print "CURRENT: ",$$hr{_},"\n";
    #say +( defined $hr->{_} ? $hr->{_} : 'CPAN'),
    #    " has ",(scalar@{[grep !/^_{1,2}$/, keys %$$hr]})," namespaces\n";
}

__DATA__
ABI                                 1.0  M/MA/MALAY/ABI-1.0.tar.gz
A                           0.5  I/ID/IDOPEREL/Abilities-0.5.tar.gz
A::BB                0.5  I/ID/IDOPEREL/Abilities-0.5.tar.gz
A::CC                  0.2  I/ID/IDOPEREL/Abilities-0.2.tar.gz
A::CC::DD             0.2  I/ID/fake/Abilities-0.2.tar.gz
XX::ZZ::YY          0.1 I/jhsjkha


####

#!perl
use strict;
use warnings;
use feature qw (say);
$|=1; 
use Diagnostics;  
use Data::Dumper; 
use Data::Dump::Streamer;
my $cpan = {a=>0}; #_=>'',__=>''

&grow_tree;

sub grow_tree {
    while (){
        chomp;
        my @fields = split /\s+/;#say "@fields";
        my @names = split /::/, $fields[0];#say "names($#names): @names";
        my $cur;
        my @ancestors = @names;
        pop @ancestors;
        #print "for ",(join '::',@names)," ancestor is ",( $ancestors[$#ancestors]||'CPAN' ),"\n";
        print "for ",(join '::',@names)," ancestor is ",( $ancestors[$#ancestors]?(join '::',@ancestors) : 'CPAN' ),"\n";
        print "\t\t-->\$cpan",(defined $ancestors[0] ?'{'.(join '}{', @ancestors ).'}':''),"\n";
        my $pater;
        say  ' $pater = \$cpan'.(defined $ancestors[0] ?'{'.(join '}{', @ancestors ).'}':'');
        eval ' $pater = \$cpan'.(defined $ancestors[0] ?'{'.(join '}{', @ancestors ).'}':'');
        say  '$cpan->{'.(join '}{', @names).'} = {_=>$names[-1],__=> \$pater}; ';
        eval '$cpan->{'.(join '}{', @names).'} = {_=>$names[-1],__=> \$pater}; ';


        print "\n";
    }
    Dump($cpan);
}
exit;
__DATA__
ABI                                 1.0  M/MA/MALAY/ABI-1.0.tar.gz
Abilities                           0.5  I/ID/IDOPEREL/Abilities-0.5.tar.gz
Abilities::Features                 0.5  I/ID/IDOPEREL/Abilities-0.5.tar.gz
Abilities::Scoped                   0.2  I/ID/IDOPEREL/Abilities-0.2.tar.gz
Abilities::Scoped::FAKE             0.2  I/ID/fake/Abilities-0.2.tar.gz
ABNF::Generator                   undef  N/NY/NYAAPA/ABNF-Grammar-0.08.tar.gz
ABNF::Generator::Honest           undef  N/NY/NYAAPA/ABNF-Grammar-0.08.tar.gz
ABNF::Generator::Liar             undef  N/NY/NYAAPA/ABNF-Grammar-0.08.tar.gz
ABNF::Grammar                      0.08  N/NY/NYAAPA/ABNF-Grammar-0.08.tar.gz
ABNF::Validator                   undef  N/NY/NYAAPA/ABNF-Grammar-0.08.tar.gz
about                             undef  S/SH/SHERWOOD/xisofs-1.3.tar.gz
above                              0.03  B/BR/BRUMMETT/UR-0.43.tar.gz



####

use strict;
use warnings;

my ($line,$cnt,@cnt_file);
#!/usr/bin/perl
open (FILE,"file1");
@cnt_file = ;
$cnt = @cnt_file;
print "$cnt\n";
open (MYFILE,"file2");
$line = ;

foreach $line () {
print "$line" if $. >= $cnt;
}


####

#!perl
use strict;
use warnings;
$|++;
my ($comp,$first,@sec);

#$comp = "descr is ".(defined $first ? q{$first} : null').