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').