Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Discipulus's scratchpad

by Discipulus (Curate)
on Jun 03, 2004 at 10:36 UTC ( #360051=scratchpad: print w/ replies, xml ) Need Help??

use strict; use warnings; my ($line,$cnt,@cnt_file); #!/usr/bin/perl open (FILE,"file1"); @cnt_file = <FILE>; $cnt = @cnt_file; print "$cnt\n"; open (MYFILE,"file2"); $line = <MYFILE>; foreach $line (<MYFILE>) { print "$line" if $. >= $cnt; }

Need help with http 1.1 headers on LWP Host =>
"Some people, when confronted with a problem, think "I know, I'll use regular expressions." Now they have two problems." -- Jamie Zaqinski "You cannot parse XHTML with regex." -- bobince on StackOverflow
#!perl use strict; use warnings; $|++; my ($comp,$first,@sec); #$comp = "descr is ".(defined $first ? q{$first} : 'null').' and list +is '.( @sec ? q{join ' ', @sec} : 'empty'); $comp = q{descr is $first and list is @sec}; my $list = q{defined $sec[0] ? 'full' : 'empty'} ; print "$comp\n"; print eval "qq{$comp}","\n"; &mf('UNO'); &ms (1);&ms (2); &mf ('DUE'); &rs; sub mf{$first = shift; my $it = eval "qq{$comp $list} ";print $it." +\n"} sub ms {push @sec, shift; print eval "qq{$comp}","\n";} sub rs {@sec=qw(); print eval "qq{$comp}","\n";} #was print "$c +omp\n"; ######### http://www.perlmonks.org/?node_id=15380 my $n = sub {1}; my $m = sub {&$n*2}; my $o = sub {&$m*2}; my $s = sub {&$n." ".&$m." ".&$o."\n"}; print &$s; $n = sub {2}; print &$s; __DATA__ #from http://www.perlmonks.org/?node_id=15437 my $text = q{ Dear $person, I know that this text is $adjective. But I wish it could be... }; my $person = 'Mom'; my $adjective = 'not interpolated'; print eval "qq{$text}";
############################################################
use strict; use warnings; my $lines = <<'EOT'; A named capture group. Identical in every respect to normal captu +ring parentheses () but for the additional fact that the group can be referred to by name in various regular expression con +structs (like \g{NAME} ) and can be accessed by name after a successful match via %+ or %- . See perlvar for more deta +ils on the %+ and %- hashes. If multiple distinct capture groups have the same name then the $+{NAM +E} will refer to the leftmost defined group in the match. The forms (?'NAME'pattern) and (?<NAME>pattern) are equivalent. NOTE: While the notation of this construct is the same as the similar +function in .NET regexes, the behavior is not. In Perl the groups are numbered sequentially regardless of being named or not. + Thus in the pattern EOT $lines=~s/^\s*(?!$)//gm; print $lines
dear chromatic,

thank you for writing the Modern Perl book: now i know that mine is baby Perl ;=)
I had no time to learn github so i'll put my typos review here.. sorry
May be something is here only because i do not understand well; excuse me.
I'll refer to the A4 pdf edition for page numbers.

i-introducing Test::More maybe better spends more wards about it's function, altough briefly.

100-middle She'll have to..
           He'll   or is omenage to someone?
118- has 'enbled' is -> 'ro' 
     has 'enbled' is -> 'rw' or i do not understand the (Note following
154- bottom line Yet Even 
                 Yet even
162-last par. The callee side 
              i think calee need explanation and maybe italic font 
165-at end of file slurp: The second example... this line is obscure..
168-bottom the last 2 lines begin with ] and, probably, a comment by someone.. 

again thank you.. the better Perl's book after many years..

L*

PS if i'll have time i want to write a little review of the book here
 
 

Ten years...

Ten years are passed from my entrance in the monasterium. maybe time flies when you are amusing.. or time flies anyway.. the fastest decade ever!

My first problem was about traversing a directory tree and i'm still remember my head boiling imagining a recursive algorithm.

The solution heard in the monastery was so simple that I was impressed.

I'm think about me as a newbie in Perl, but ten years here and near the compiler make me a skilful one.

I used Perl in many many different environment and with etherogeneous purposes: Win32 sysadmin, CGI, databases, Tk, linux sysadmin, LWP, some math and fun.. Here I ever found some big ol' monk suggesting the right thing, quickly and friendly.

In last ten years few think are still solid point in this floating reality: my woman, my kawasaki gpz and PerlMonks; I learned the order of priorities may be confused if you not follow The Twelves Pillars Of Wisdom..


Here you can walk in the cloister and hazard to asks some wise one about strange, until you know the truth, Perl's feature (like the uppercaseness of %ENV's keys on win32, or the prefilled input using Term::ReadLine), or hear discussion about storing log as video file to enjoy the compression, or whisper about hexagonal tessellation in Tk and having back a working program in two days..

Here you can search back in the time and find old answer that still works for an enormous amount of problems.

Here you can rediscover that Perl'programmers are still humans (minus some one that only play one on Earth server): may be one day someone is nervous or sad or upset.. but everyday is here creatively.

Here I have meet a lot of people; the monastery was my only netplace ever. Some monk is lost during this years, few one physically too.. we miss them all.

HereI discovered the escathological doctrine of Perl6 (i heard it can write bytecode to stones for a geological later retrieve..) waiting the future revenge of Perl on the rest of the IT.

Here i saw little hashes grow and reference themselves and become objects, blessed by Some::Class, and object becomes transparent, translucent, singletons or insideout ones (it everytime remind me the poor babuin of 'the Fly' movie..).. and as you turn your eyes:"Eeek a Moose!".

Here you can have the folgoration that Perl let you to be near the compiler so you can evaluates what you want (arbitrium).

Here you learn how laziness is an hard work.

Here, if you are hungry, you go down in the kitchen and choose some DBI recipe that suit your taste.

Here you wake up and peoples from everywhere greet you with a "good localtime(time)!".

So monks i very pleased this Ten Years... Thank you to all!
Urrah! Urrah!


L*



------------- ten years... ten years are passed from my entrance in the monasterium. maybe time flies when you are amusing.. or time flies anyway. My first problem was about traversing a directory tree and i'm still remember my head boiling imagining a recursive algorithm. The solution eard in the monastery was so simple that I was impressed. I'm think about me as a newbie in Perl, but ten years here and near the compiler make me a skilfull one. I used Perl in many many different environement and with etherogeneous purposes: Win32 sysadmin, CGI, databases, Tk, linux sysadmin, LWP, some math and fun.. Here I ever found some big ol' monk suggesting the rigth thing, quickly and friendly. Here you can walk in the cloister and hazard to aks some wise one about strange, until you know the truth, perl feature (like the uppercaseness of %ENV's keys on win32, or the prefilled input using Term::ReadLine), or ear discussion about storing log as video file to enjoy the compression, or whisper about hexagonal tasselation in Tk and having back a working program in two days.. Here you can search back in the time and find old answer that still works for an enourmous amount of problems. Here you can rediscover that Perl'programmers are still humans (minus some one that only play one on Earth server): may be one day someone is nervous or sad or upset.. but everyday is here creatively. Some one is lost during this yaers, few one phisically too.. we miss them all. Here I learned the escathological doctrine of perl6 (i eard it can write bytecode to stones for a geolocical later retrieve..) waiting the future revenge of Perl on the rest of the IT. Here i saw little hashes grow and reference themselves and become objects, blessed by Some::Class, and object becomes transparent, translucid, singletons or insideout ones (it everytime remind me the poor babuin of 'the Fly' movie..).. and as you turn your eyes:"Eeek a Moose!". Here you can have the folgoration that Perl let you to be near the compiler so you can evaluates what you want (arbitrium). Here you learn how laziness is an hard work. Here if you are hungry, you go down in the cook room and choose some DBI recipe that suit your taste.


Dear zentara, I was fast-att-hacking-and-paste some code to display jpg photos and, as you can see, I get this pics dinamically and I fetch their dimensions,url and comment. I' want this acting in a fullscreen mode with pics smaller than the screen ($sx $sy >= $px $py) well centered with an elegant black bg and pics bigger to be resized. this code works quite but the tk part is a horrible and buggy (it does not take the focus when a new pic is on..) thanks a lot Lorenzo
#!/usr/bin/perl -w use REST::Client; use JSON; use Data::Dumper; use LWP::Simple; use Tk; use Tk::JPEG; use constant DELAY => 1000; my $index = 0; my $client = REST::Client->new(); $client->GET('http://www.panoramio.com/map/get_panoramas.php?order=po +pularity&set=public&from=0&to=100&minx='.$ARGV[0].'&miny='.$ARGV[1].' +&maxx='.$ARGV[2].'&maxy='.$ARGV[3].'&size=original'); my $aoh = decode_json $client->responseContent(); my @urls; #print Dumper $aoh; foreach my $pic(@{$aoh->{photos}}) { print "$pic->{photo_file_url}\n"; print "$pic->{photo_title}\n"; print "$pic->{latitude} $pic->{longitude} ($pic->{width +}x$pic->{height})\n\n"; push @urls,$pic->{photo_file_url}; } ###################################################################### +########## my $mw = new MainWindow(-background=>'black'); #$mw->FullScreen(1); #$mw->geometry($mw->screenwidth . 'x' . $mw->screenheight . '+0+0'); my $sx =$mw->screenwidth; my $sy =$mw->screenheight; my $image = $mw->Photo(); #qw/-width 800 -height 600/ $mw->bind('all' => '<Key-Escape>' => sub {exit;}); $mw->Button(-image => $image,-background => 'black')->pack(-side => "t +op", -fill=> "both"); $mw->after(DELAY, \&next_image); MainLoop; ###################################################################### +########## sub next_image { $image->blank(); my $file = &download(${$aoh->{photos}}[$index]{photo_file_url}); my $title = ${$aoh->{photos}}[$index]{photo_title}; my $px = ${$aoh->{photos}}[$index]{width}; my $py = ${$aoh->{photos}}[$index]{height}; print "NEXTIMG: $px x $py\n"; if (eval {$image->read($file,-shrink); 1}) { if ($px >= $sx and $py >= $sy ) { print "SUBSSAMPLING: $px/$sx , $py/$sy: ",$px/$sx,' ',$py/$s +y,"\n"; $image->copy($image, -subsample => ( int ($px/$sx),int + ($py/$sy) )); #, $py/$sy } else { #$image->copy($image, -zoom => ( 2,2)); } $mw->configure(-title => $title,-width=>$px, -height=> $py); + #,-width=>$x, -height=> $y $mw->after(DELAY, \&next_image) if (++$index <= $#{$aoh->{phot +os}}); } else { $mw->after(0, \&next_image) if (++$index <= $#{$aoh->{photos}} +); } } sub download{ my $url=shift; print "RECEIVING: $url\n"; mirror ($url, 'file.jpg'); return 'file.jpg' }
while (<DATA>){ chomp; my @temp = split /\?/,$_; $ipmatch = $temp[0] ; #unless defined $ipmatch; next unless $temp[4] eq 'Started'; $dati{$.} = { webnum=>$temp[1], alias => { map {$_ => &risolvi( $_ )} split / +/,$temp[12] } , }; } sub risolvi{ my $host = shift; my $dnsserver = '122.211.222.221'; my @arr; open DNS, "nslookup $host $dnsserver 2>&1|"||die; while (<DNS>) {push @arr, $_} if ($arr[0]=~/\s*Non-existent domain/ ){return ("NON-EXI +STENT-DOMAIN")} elsif ($arr[0]=~/Non-authoritative answer:/ ) {$arr[5]=~ +/\s*(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/;return ("NON-AUTH: $1")} elsif ($arr[4]=~/\s*(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}) +/ ){return $1;} else {return ("????")} close DNS; } __DATA__ 999.110.136.999?50?www.google.it?usr1?Started?c:\webroot\google?172517 +?NA??--?--?--?www.google.it www.google.com www.google.org ?? 999.110.136.999?51?www.fedoracore.it?usr2?Started?c:\webroot\thebossma +nagement?835304?NA??--?--?--?www.fedoracore.it ?? #!perl use strict; use warnings; use GD; use GD::Polyline; # create an image use GD::Text::Align; my $image = new GD::Image (1024,768); my $align = GD::Text::Align->new($image, valign => 'top', halign => 'left', ); ################### COLORI my $gray = $image->colorAllocate(127,127,127); my $white = $image->colorAllocate(255,255,255); my $black = $image->colorAllocate( 0, 0, 0); my $red = $image->colorAllocate(255, 0, 0); $image->setThickness(1); ################### COSTANTI my $pig = 3.141592653589793238462643383279502884197169399375; my $radius = 90; my $apo = ($radius*sqrt(3))/2; ################### initial positioN of the center my $xc = 512; my $yc = 384; my $vertex= 6; ################### MAIN #### &hexagon($xc,$yc); print "original coord: $xc -- $yc\n-------------\n"; $align->set_text("X"); $align->draw($xc,$yc,0); foreach my $cardinal (qw(N NE SE S NO SO)) { my ($xc2, $yc2) = &vicini ($xc,$yc,$cardinal,1); #$yc2=sprintf("%10.3f",$yc2);#CORREZIONE print "$cardinal coord: $xc2 -- $yc2\n"; $align->set_text($cardinal); $align->draw($xc2,$yc2,0); &hexagon($xc2,$yc2); } &disegna; ############################################################ sub hexagon { my $xc = shift; my $yc = shift; my $poly = new GD::Polygon; foreach my $i (0..5 ){ my $newX=$xc+($radius*cos($i*2 *$pig/$vertex)); my $newY=$yc+($radius*sin($i*2 *$pig/$vertex)); $poly->addPt( $newX, $newY); $align->set_text(" $i "); $align->draw($newX,$newY,0); } $image->polydraw($poly,$black); #my @vertices = $poly->vertices; } ############################################################ sub disegna { open PNG, ">testHEX2.jpeg"; select PNG; binmode PNG; print $image->jpeg(100); } ############################################################ sub vicini { my $xc = shift; my $yc = shift; my $quale = shift; my $dist =shift||1; my %vicini = ( SE => sub{my $xc2 = $xc+($radius*3/2) *$dist; my $yc2 = $yc+ $apo *$dist; return($xc2,$yc2)}, NE => sub{my $xc2 = $xc+($radius*3/2) *$dist; my $yc2 = $yc- $apo *$dist; return($xc2,$yc2)}, N => sub{my $xc2 = $xc; my $yc2 = $yc- $apo*2 *$dist; return($xc2,$yc2)}, S => sub{my $xc2 = $xc; my $yc2 = $yc+ $apo*2 *$dist; return($xc2,$yc2)}, NO => sub{my $xc2 = $xc-($radius*3/2) *$dist; my $yc2 = $yc- $apo *$dist; return($xc2,$yc2)}, SO => sub{my $xc2 = $xc-($radius*3/2) *$dist; my $yc2 = $yc+ $apo *$dist; return($xc2,$yc2)}, ); return &{$vicini{$quale}}($xc,$yc); }
Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (14)
As of 2014-09-22 16:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (198 votes), past polls