use LWP::UserAgent;
my $ua = LWP::UserAgent->new();
my $req = HTTP::Request->new(GET => 'ftp://ftp.io.com/pub/usr/tshinnic/respons1.txt');
$req->header(Range => sprintf("bytes=%d-%d", 256, 511) );
my $rsp = $ua->request($req);
# Check the outcome of the response
if ($rsp->is_success) {
print $rsp->content;
} else {
print $rsp->status_line, "\n";
}
####
-----------------8<---------8<------------------
use Benchmark qw(cmpthese);
sub reveal { my $t; ($t = $_[0]) =~ s/\cH/\\b/g; $t; }
my %methodstocheck = (
'uk()' => \&uk_for_check,
'new1()' => \&new1,
'smack()' => \&smack,
'smacknew()' => \&smacknew,
'badkcams()' => \&badkcams_for_check,
'othersmack()' => \&othersmack,
);
my %methodstotest = (
'uk()' => \&uk,
'new1()' => \&new1,
'smack()' => \&smack,
'smacknew()' => \&smacknew,
'badkcams()' => \&badkcams,
'othersmack()' => \&othersmack,
);
my %teststrings = (
smackem => [
"\bthis is an\b correct\b\b\b usage\b",
"this is a corr usag",
],
ukky => [
"\bMy first attempt was slightly\b\b\b\b\b\b\b\bvery buggy, maybe thus\b\bis wa\b\bis better??\b",
"My first attempt was very buggy, maybe this is better?",
],
riced => [
"\bt\b\bhello",
"hello",
],
);
my @passedtests;
print "\nChecking methods for corrrect results:\n";
foreach my $methodname (sort keys %methodstocheck) {
printf " Testing method '%s' ...\n", $methodname;
my $rmethod = $methodstocheck{$methodname};
my $notok;
foreach my $testname (sort keys %teststrings) {
$s = $teststrings{$testname}[0];
$x = $teststrings{$testname}[1];
my $result = &{$rmethod}();
if( $x ne $result ) {
++$notok;
printf " Method '%s' failed test '%s'\n", $methodname, $testname;
printf " Expecting '%s'\n", reveal($x);
printf " Result was '%s'\n", reveal($result);
}
}
if( $notok ) {
# printf " Method '%s' failed %d tests\n", $methodname, $notok;
} else {
# printf " Method '%s' passes tests\n", $methodname;
push @passedtests, $methodname;
}
}
printf "\n %d tests passed, will benchmark '%s'\n",
scalar(@passedtests), join("', '",@passedtests);
my %benchmark = map { $_, $methodstotest{$_} } @passedtests;
$s = "\bthis is an\b correct\b\b\b usage\b";
$s = "\bt\b\bhello";
$s = "\bMy first attempt was slightly\b\b\b\b\b\b\b\bvery buggy, maybe thus\b\bis wa\b\bis better??\b";
cmpthese(-1, \%benchmark );
$s x= 100;
cmpthese(-1, \%benchmark );
sub uk_for_check {
$a = $s;
my $awhile = 256;
$a =~ s[(?:[^\cH]\cH|^\cH)][]g
while $awhile-- && (1+index($a,chr(8)));
$a .= ' but loops!' unless $awhile > 0;
$a;
}
sub uk {
$a = $s;
$a =~ s[(?:[^\cH]\cH|^\cH)][]g while 1+index $a, chr(8);
$a;
}
sub new1 {
$a = $s;
while ($a =~ s/(?:[^\cH]\cH|^\cH+)//g) {}
$a;
}
sub smack {
$a = $s;
do 1 while ($a =~ s/(?:[^\cH]\cH|^\cH+)//g);
$a;
}
sub smacknew {
$a = $s;
$a =~ s/^\cH+//;
1 while ($a =~ s/[^\cH]\cH//g);
$a;
}
sub othersmack {
$a = $s;
1 while ($a =~ s/[^\cH]\cH//g);
$a =~ s/^\cH+//;
$a;
}
sub badkcams_for_check {
$a = reverse $s;
my $awhile = 256;
$a =~ s[\cH[^\cH]|\cH$][]g
while $awhile-- && (1+index($a,chr(8)));
$a = reverse $a;
$a .= ' but loops!' unless $awhile > 0;
$a;
}
sub badkcams {
$a = reverse $s;
$a =~ s[\cH[^\cH]|\cH$][]g while 1+index $a, chr(8);
reverse $a;
}
__END__
Checking methods for corrrect results:
Testing method 'badkcams()' ...
Testing method 'new1()' ...
Testing method 'othersmack()' ...
Testing method 'smack()' ...
Testing method 'smacknew()' ...
Method 'smacknew()' failed test 'riced'
Expecting 'hello'
Result was '\bhello'
Testing method 'uk()' ...
5 tests passed, will benchmark 'badkcams()', 'new1()', 'othersmack()', 'smack(
)', 'uk()'
Rate smack() new1() uk() badkcams() othersmack()
smack() 188/s -- -96% -97% -97% -99%
new1() 5067/s 2594% -- -7% -24% -86%
uk() 5470/s 2808% 8% -- -17% -85%
badkcams() 6624/s 3422% 31% 21% -- -82%
othersmack() 37522/s 19850% 641% 586% 466% --
Rate smack() new1() uk() badkcams() othersmack()
smack() 42.1/s -- -23% -31% -45% -93%
new1() 55.0/s 31% -- -10% -28% -91%
uk() 61.4/s 46% 12% -- -20% -90%
badkcams() 76.9/s 83% 40% 25% -- -88%
othersmack() 632/s 1400% 1048% 929% 721% --
-----------------8<---------8<------------------
####
-----------------8<---------8<------------------
use strict;
use warnings;
my $filename = 'tablet2.data1.txt';
open( IN, "<$filename" )
or die "Unable to open input file '$filename': $!";
local $/ = undef;
my $buf = ;
my $pattern = 'The text to be searched\s*in differnt lines inclunding\s*white lines and indentation\s*';
my $replace = <<'EOF';
It seems like
magic
but it's really just waving wands 'n stuff
EOF
$buf =~ s/$pattern/$replace/;
print $buf;
close(IN);
-----------------8<---------8<------------------
use strict;
use warnings;
use Tie::File;
# tie @array to filename using Tie::File
tie my @array, 'Tie::File', 'result.txt'
or die "Cannot open result.txt:$!";
#while( ) {
for(@array) {
my $pattern = "The text to be searched in differnt lines inclunding white lines and indentation";
my $replace = " The replacing text also in multiple lines including white spaces and white lines ";
$pattern = '\s\s';
$replace = '||';
s/$pattern/$replace/g;
}
#}
untie @array;
####
-----------------8<---------8<------------------
#!/usr/bin/perl -w
# vim:ft=perl:ts=4:sw=4:et:is:hls:ss=10:
use strict;
use warnings;
use Pod::Usage;
# pod2usage( -exitval => 1, -output => \*STDERR );
pod2usage( -exitval => 1, -output => \*STDOUT );
=head1 NAME
burble burble
=head1 SYNOPSIS
asdf
asdf
adsf
asdf
asdf
=cut
-----------------8<---------8<------------------
####
#!/usr/bin/perl -w
use strict;
#use Tie::SortedHash;
use LR;
my @months = qw(January February March April May June July August September October November December);
my (%data, %order);
@data{@months} = (33, 29, 15, 48, 23, 87, 98, 44, 12, 19, 76, 23);
@order{@months} = (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12);
my $sort = sub {
my $hash = shift;
sort {$order{$b} <=> $order{$a}} keys %$hash;
};