Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

shenme's scratchpad

by shenme (Priest)
on Jun 01, 2004 at 23:46 UTC ( [id://358841]=scratchpad: print w/replies, xml ) Need Help??

use LWP::UserAgent; my $ua = LWP::UserAgent->new(); my $req = HTTP::Request->new(GET => 'ftp://ftp.io.com/pub/usr/tsh +innic/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<------------------

+/- Questions (Top)

  • Drowning in Modules - Suggest those for DB App (A)

    [KevinR]


  • How to recognize url in text and convert to hyperlink, unless already in anchor (A:2)+/-

    [Anonymous Monk]


  • Brawling Javascript (CU:1)+/-

    [mariol]


    -----------------8<---------8<------------------
    He's mad, you see, quite mad.
    Re: Re: Re: Re: Re: Re: should this backspace removal code be done better?
    -----------------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", $method +name, $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() ot +hersmack() 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() ot +hersmack() 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<------------------
    For tablet:
    -----------------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 = <IN>; my $pattern = 'The text to be searched\s*in differnt lines inclun +ding\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( <result.txt> ) { for(@array) { my $pattern = "The text to be searched in differnt lines inclu +nding white lines and indentation"; my $replace = " The replacing text also in multiple lines incl +uding white spaces and white lines "; $pattern = '\s\s'; $replace = '||'; s/$pattern/$replace/g; } #} untie @array;
    That's it. For my test file I just copied the original source text into result.txt.   After running it I saw:
    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( <result.txt> ) {
    ||||for(@array) {
    ||||||||my $pattern = "The text to be searched in differnt lines inclunding whit
    e lines and indentation";
    ||||||||my $replace = " The replacing text also in multiple lines including whit
    e spaces and white lines ";
    ||||||||s/$pattern/$replace/;
    ||||}
    }
    untie @array;
    

    For sunadmn:
    It seemed to just work fine for me, once I realized I hadn't told it which section to print. That is, I'd originally typed just "=head1 burble". It was looking for "=head1 SYNOPSIS" in particular.

    -----------------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<------------------
    ================================================
    C:\Archive\Perl\Mine\test>perl -w lr.pl
    BEFORE CHANGING ORDER
    December had 23 million sales.
    November had 76 million sales.
    October had 19 million sales.
    September had 12 million sales.
    August had 44 million sales.
    July had 98 million sales.
    June had 87 million sales.
    May had 23 million sales.
    April had 48 million sales.
    March had 15 million sales.
    February had 29 million sales.
    January had 33 million sales.
    
    AFTER CHANGING ORDER
    August had 44 million sales.
    November had 76 million sales.
    April had 48 million sales.
    September had 12 million sales.
    December had 23 million sales.
    July had 98 million sales.
    February had 29 million sales.
    May had 23 million sales.
    October had 19 million sales.
    January had 33 million sales.
    June had 87 million sales.
    March had 15 million sales.
    
    Current code is:
    #!/usr/bin/perl -w use strict; #use Tie::SortedHash; use LR; my @months = qw(January February March April May June July August Sept +ember 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; };

    Pack/Unpack Tutorial (aka How the System Stores Data)
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others contemplating the Monastery: (6)
As of 2024-03-19 05:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found