Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid

The Monastery Gates

( #131=superdoc: print w/ replies, xml ) Need Help??

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
How to issue "Ctrl-y" to a network device
1 direct reply — Read more / Contribute
on Dec 26, 2014 at 01:59
    Hello Monks,

    I am executing commands on telecommunications 2G/3G network devices like GCS /MSS. On these elements, once a command is executed,i need to issue a "Ctrl-y" ( Contol y command) to exit from the previous prompt.But, I am not able to issue Ctrl-y to the device.This makes the device to wait until it times out and continue with other commands. This is delaying my script to execute and it is running for more than one day.I am able to enter into the router from which i can issue commands on to the device,but i am not able to "\cy" command on the device. Your help is much appreciated.


Method of child module called by parent
1 direct reply — Read more / Contribute
by gzartman
on Dec 25, 2014 at 23:51
    I'm somewhat new to perl OOP. I've been working on a perl module and found that it was getting a big unwieldy, so decided to spin off a few child classes to my main class to help organization and what not. I'd like to be able to call methods from the child class as if they were in the parent class (at least that's how I envisioned this working). Simplified example:
    package parentClass; use parentClass::childClass; sub new { my ($class, %params) = @_; my $self = {}; bless ($self, $class); return ($self); } 1; package parentClass::childClass; sub new { my ($class, %params) = @_; my $self = {}; bless ($self, $class); return ($self); } sub myMethod { return ('Yo I am one sweet method'); } Test Script utilizing these classes: use parentClass; $object = parentClass->new(); print $object->myMethod();
    When I do this, perl complains that it can't find myMethod. I'm betting this is something fairly simple, but I can' figure it out. Thanks.
Way to calculate day-of-the-week
4 direct replies — Read more / Contribute
by sylph001
on Dec 24, 2014 at 03:42

    Hi everyone,

    Recently I'm writing a small perl program and I find out that for some certain day-of-the-month numbers, I need to count out the corresponding day-of-the-week numbers.

    I could write a routine to do that work but turns out it will be complicated.

    I think there must be some precedences done for doing this work.

    I guess there might be some useful functions in modules like Local::Time or so, but I feel not familiar with the wider industry and standard way that most people do it with.

    So, could you kindly lead me to the best/most-common way to do this date calculation?


    Many thanks

    </body> </html>
How to hide the Contents in script
5 direct replies — Read more / Contribute
on Dec 23, 2014 at 03:37
    Hi monks, I wanted to know, is there any way to hide the Content in Script before giving it to Third party users. I dont want others to see the script, it will be better to provide only the executable(exe) like files. Is there any way to do that?
[Re]confirm box
1 direct reply — Read more / Contribute
by kbee
on Dec 23, 2014 at 03:02

    I am in an unique 'perl' situation in trying to embed a reconfirm box into an existing perl/cgi script, and let the perl script continue processing through its code based on the yes/no response of the user. To further describe my situation, the user currently launches an operational webpage and selects an app service and an actioneither activate, de-activate or check status and clicks submit. A confirm box shows up to accept the yes/no response from the user. A yes response results in the servicename and action passed onto the perl/cgi script which goes ahead in carrying out the selected action while displaying the results in a separate window with appropriate header and footer information. I needed to embed a confirm box again into the perl code if the action was 'de-activate' and have perl hold its further processing until the user responds back with a yes again. So far after googling through web postings and using perl/javascript snippet examples, the perl/cgi script does throw up the second confirm box if the action is de-activate, but it continues onward irrespective of a response from the box or not. I have attached sections of the code below and appreciate your expert advice from you perl monks. Though I am familiar with perl programming, integrating the second confirm box has been a challenge. Thanks for reading my post.

    #!/usr/bin/perl -w # use CGI; use CGI::Carp qw (fatalsToBrowser); use Cwd; use lib getcwd . '/lib'; use COI::INIFile; use COI::Logger; use File::Basename; use COI::Commands; use Sys::Hostname; use strict; ...... ...... my $q = CGI->new; print $q->header('text/html'); #print $q->Dump(%ENV); ### get values from html form my $username = $q->param("username"); my $action = $q->param("option_1") ; my $service = $q->param("option_2") ; print "</left><pre>\n"; &print_header; if ( $action eq 'Status') { my $wait_for_user_response = "yes"; if(defined($q->param("userresponse"))) { if($q->param("userresponse") eq "yes") { print "go ahead \n"; } else { print "don't go ahead \n"; } } print "<html>\n"; print "<head>\n"; print "<LANGUAGE=Javascript>\n"; print "<script>\n"; print "function CheckForm_onclick()\n"; print "{\n"; print "var myForm = document.form1;\n"; print "var message = \"\";\n"; print "message = \"Confirm if you need to disable $ser +vice. Choose OK to go ahead and Cancel to abort.\";\n"; print "var answer = confirm(message);\n"; print "if (answer == false ){ \n"; print "document.write(\'You chose to Cancel. Closed wi +ndow.\');\n"; print "}\n"; print "else {\n"; print "document.getElementById(\"userresponse\").value + = \"Yes\";\n"; print "document.form.submit();\n"; print "}\n"; print "}\n"; print "</SCRIPT>\n"; &reconfirm_form; } print "\n Going ahead made it\n"; &footer(); sub reconfirm_form { print "<title>$tool_desc</title>\n"; print "</head>\n"; print "<body onload=\"return (CheckForm_onclick())\">\n"; print "<FORM action=\"disable.cgi\" method=\"post\">\n"; print "<input type=\"hidden\" name=\"userresponse\" >\n"; print "</form>\n"; print "</body>\n"; print "</html>\n"; }
Have a multiple file in directory and want to manipulate in each files in incremental order. All the file have same value.
3 direct replies — Read more / Contribute
by hemantjsr
on Dec 23, 2014 at 02:34

    Please find below Working Code. It's giving error message "Use of uninitialized value $lines1 in substitution (s///) a"

    apart from that it's giving a result like in a file01.txt have now file01.txt, in file02.txt have file02.txt only and so on. Old values are deleted and only filename are comeing file.

    where as i needed output like

    file01.txt have 11 10,9:10/4947000219 :20140924105028 24

    file02.txt have 11 10,9:10/4947000220 :20140924105228 24

    file03.txt have 11 10,9:10/4947000221 :20140924105428 24

    file04.txt have 11 10,9:10/4947000222 :20140924105628 24

    #!/usr/bin/perl use strict; use 5.10.0; # For autodie and regex \K use autodie; use File::Find; use Time::Piece; use Time::Seconds qw/ ONE_MINUTE /; use constant DATE_FORMAT => '%Y%m%d%H%M%S'; my $n; my $directory="/home/e/Doc/AutoMation"; chdir $directory; opendir(DIR, ".") or die "couldn't open $directory: $!\n"; foreach my $file (readdir DIR) { next unless -f $file; open my $in_fh, '<',$file; my @lines = <$in_fh>; close $in_fh; ++$n; $lines[0] =~ s~/4947000219/\K(4947000210+)~$1+$n~e; $lines[1] =~ s{:20140924105028\K(20140924105028+)}{ my $tp = Time::Piece->strptime($1, DATE_FORMAT); ($tp + ONE_MINUTE * 2 * $n)->strftime(DATE_FORMAT); }e; open my $out_fh, '>', $file; print $out_fh @lines; close $out_fh; } closedir DIR;
Trying to understand hashes (in general)
6 direct replies — Read more / Contribute
by james28909
on Dec 23, 2014 at 00:06
    Hello Monks! I am trying my best to understand exactly how to add just a key without a value to a hash. I understand very little when it comes to hashes, and I am trying to get away from using arrays, because it is to my understanding that finding a certain key in a hash is much quicker than finding an element in an array if you have a huge amount of elements.

    So what i was planning on doing was migrating a few of my scripts to use hashes instead of arrays. Here is the code i have (which works) but i am uncertain as to how it works tbh.
    use warnings; use strict; my $path = shift; opendir( my $DIR, $path ); my %dirs; while ( my $file = readdir($DIR) ) { next if ( $file eq '.' || $file eq '..' ); $dirs{$file} = $file; } print "$_\n" for sort keys %dirs; #print "$_\n" for sort values %dirs; #same as keys... #print "$_\n" for sort %dirs;
    This will read a directory of course, and will print out that directories contents whether it be file or directory. Also, if you comment out the first print statement, and uncomment the last print statement, it will print duplicates and i am unsure as to why it is adding the filename to key and value of the hash.

    Any insight into this would be very much appreciated and thanks.

    EDIT: What I am going to eventually shoot for, is making a hash of hashes. and in each of these hash of hashes will be directories and filenames respectively, so any input on that would be appreciated as well. :)
Best way to store/sum multiple-field records?
3 direct replies — Read more / Contribute
by bobdabuilda
on Dec 22, 2014 at 18:49

    Hi guys, quite rusty on my Perl as I've been stuck doing other stuff for quite some time. Am currently trying to help a colleague sort out an issue he has with a small Perl script he's inherited.

    Basically, the script reads in some data in the form of:

    USERID1|2215|Jones,Tom| USERID1|1000|Jones, Tom| USERID3|1495|Dole, Bob| USERID2|2500|Francis, Pope| USERID2|1500|Francis, Pope|

    The goal is to process each of these records, keep a running total of the values in the second field, then output the ID, the sum of the second field for that ID, and the name.

    I managed to fix a couple of minor things that were wrong in it (no trailing pipe on the end of the record causing additional blank lines in the output, small things like that), but am not sure on the best way to handle this with the additional field. The (broken) code he currently has is:

    #!/usr/bin/perl use strict; use warnings; my ($key,$value,$reason); my %sum=(); while(<>) { unless(/.*\|(\d+)/){print STDERR "dropped line: \"$_\""; next;} ($key,$value,$reason) = split(/\|/); $sum{$key}+=$value; } foreach $key (keys %sum){print "$key|$sum{$key}|$reason\n";}

    Running the above gives the following result:

    USERID3|1495|Francis, Pope USERID1|3215|Francis, Pope USERID2|4000|Francis, Pope

    The obvious issue here is $reason - it's not being stored anywhere during the loop, so just repeating the $reason from the last record in the data... but I'm not sure of the best way to do this? It's easy enough when just dealing with the first two fields, as you can use a simple hash, as is being done already.

    I'm just not sure of the best way to add the extra info into this? Is a hash of hashes required to get the additional element in? I've not played with complex hashes before, so suggestions/examples would be much appreciated.

Redefined import method and EXPORT not working
1 direct reply — Read more / Contribute
by Anonymous Monk
on Dec 22, 2014 at 01:13

    I redefined the import method of a module

    package M1; use parent qw(Exporter); our @EXPORT; sub func{print "Hello"} sub import{print "Imported";@EXPORT=qw(func)} 1;

    And EXPORT is not working

    perl -I. -le 'use M1;func()' Imported Undefined subroutine &main::func called at -e line 1.

    But when I don't redefine import function, EXPORT works fine

    package M1; use parent qw(Exporter); our @EXPORT; sub func{print "Hello"} #sub import{print "Imported";@EXPORT=qw(func)} 1;
    perl -I. -le 'use M1;func()' Hello
    How can I get both redefining import and EXPORT to work?
comma(or fat comma) in 'use' directive
3 direct replies — Read more / Contribute
by Anonymous Monk
on Dec 21, 2014 at 23:20

    Like this sentence:

    use Test::Simple tests => 1;

    Sometimes I see there is a fat comma on use directive Of course I would think they are functions if it looked like:

    use Foo::Bar qw(func1 func2);

    But in the first case, '1' cannot be a function name. So what is that '1'? Is it a parameter to the function 'tests' or a parameter to the module Test::Simple or what???

Seeking regexp @ARGV arrays Wisdom
4 direct replies — Read more / Contribute
by Anonymous Monk
on Dec 21, 2014 at 10:24

    Thank you in advance. I am writing a short program, a game, that tests your knowledge of GNU/Linux commands and programs (with a whatis entry). I want it to put like flash cards: present the name of the command, wait for the user, then print the description, wait for the user, ad infinitum. The code below shows the first attempt (SLATHERED WITH COMMENTS):

    #!/usr/bin/perl #bashflash #tests your memory of bash/gnu-linux commands and cli programs #USAGE: #cd to the directory containing the binarys of the programs #you want to test your knowledge of (DO NOT NEED TO BE ROOT) #pass perl bashflash -`whatis --wildcard *` # use strict; use warnings; #The following loop utilizes a shift-and-push loop #to shift the zeroth element of @ARGV out of the array, into a scalar, #then push the scalar back into the array as the final element. #effectively, this process lets one cycle through the output of #`whatis --wildcard *` indefinitely, *while separating the #command names from their descriptions, like flashcards.* #*In it's current implementation, @ARGV stores the output of `whatis` #word by word: such that elements are delineated by spaces. my $currentcard; #this variable holds onto strings shifted off of @ARG +V #, prints them, then pushes it's contents #back onto the end of ARGV while (1) { #infinite loop START $currentcard = shift; #shift first element #of @ARGV into $currentcard print $currentcard; push (@ARGV, $currentcard); #push $currentcard #(previously element 0) back onto #@ARGV as the last element <STDIN>; #Wait for user } #infinite loop END exit; #the script never gets here, #but I always explicitly exit on the end of my Perl. #and then an empty comment line #

    This program puts this to STDOUT:

    Note, each line after "-bash" had to be summoned by the return key, meaning that (as explained in the comments) @ARGV has stored the command line argument into new elements by word. (This is my current understanding, please correct me.)

    #1, the negative testing while

    #2, the while controlled by internal positive testing if

    Above: an attempt, two of many, to get the "flash card" output I desire. My plan is to instead push the shifted elements of @ARGV onto an Array in a regexp-conditional loop, to attempt to match the "- " in the last element of Array, if it does match "- ", then the code should exit the loop and print everything it collected up to and including the "- ", then pushing it's content back onto the end of @ARGV, and waiting for the return key press. Or the logical equivalent, test positive for iteration with the lack of "- ", and keep adding to Array until shift adds a "- ". As above.

    I have tried dozens of variations with positive and negative regular expressions, I even tried /.*/, but every time I try to group the output such that iterations of print are delimited by "- ", just I get blank lines.

    Am I using push and shift incorrectly?

    Prithee, great archons of perl, behelpeth me.

New Meditations
The Top Ten Perl Poems
2 direct replies — Read more / Contribute
by eyepopslikeamosquito
on Dec 26, 2014 at 02:04

    Following on from The Top Ten Perl Obfus, let's count down the top ten highest rated Perl Monks poems of all time.

    Since I cannot super-search by node reputation, please note that this list is based only on some non-exhaustive searching and my fallible memory. So it's quite likely I've overlooked a deserving poem. If so, please let us know, and I'll correct the root node. Note that, to make the top ten, a poem needs a reputation of at least 120.

    That said, please feel free to mention any poem you consider deserving of a wider audience, even if it does not meet the formal reputation criteria. For example, I'd like to recognize and congratulate liverpole for pulling off a brilliant stunt of posting a poem entitled 600000 nodes as the 600000th PerlMonks node!

    Unlike obfus, I discovered the top ten qualification criteria for poetry is not so clear-cut. For example, what many folks believe to be the finest Perl Monk node of all time, namely 1st Monasterians by Erudil, was posted not as a poem, but a meditation. Though somewhat poetic, I judged that this node did not qualify because it was not a Perl poem and was not posted in the Perl Poetry section. Curiously, a response to this node, namely Re: 1st Monasterians by japhy, did qualify because, though it too was not posted in the Poetry section, it was definitely a Perl poem. Conversely, though posted in the Perl Poetry section, I chose to disqualify Aaah, spring (A Very Special Perlmonks Contest) by boo_radley because it was a poetry competition, rather than a poem. Admittedly, these decisions were somewhat arbitrary, and someone else may have decided differently.

    Now to work.

    No 10: Stayin' Alive (with CPAN) by joecamel Feb 05 2004 rep:120+

    Well, you can tell by the way I use File::Lock
    I'm a Perl Monk: no time to talk
    Got DBI and Test::More,
    been reusin' code since version four

    You know it's all right. It's okay.
    With GD::Graph and Class::Flyweight.
    We don't have time to reinvent
    so we get it from CPAN.

    Whether you're a hacker or whether you're a slacker
    You're stayin' alive, stayin' alive.
    net communicatin' and input validatin',
    And we're stayin' alive, stayin' alive.
    Ah, ha, ha, ha, stayin' alive, stayin' alive.
    Ah, ha, ha, ha, stayin' alive.

    To the tune of Stayin' Alive by the Bee Gees.

    Though not a prolific poster, joecamel produced a number of fine poems and obfus, such as Everybody was Obfuscating and It Came From the Crypt!. A true Perl Monk artist.

    No 9.3: The Tao of Programming, Chapter 1 by Felonious Oct 08, 2002 rep:120+

    package Tao::Book::1; # The silent void $master_programmer = bless \$programmer, 'Tao'; $master_programmer->spake(qq{ When you have learned to snatch the erro +r code from the trap frame, it will be time for you to leave. }); # 1.1 () = do { open STDOUT, ">/dev/null"; 1 while $mystery; $mystery =~ /(\001|\000)+/; $_ = $mystery; *{'Tao of Programming'} = *_; if ($tao = 'great') { $^O = 'great'; } if ($^O eq 'great') { $^X = 'great'; } if ($^X eq 'great') { $0 = 'great'; } for $user (@world) { $user->{':)'}++ } (sub { $morning->{wind} = @_; return $morning })->(${'Tao of Pr +ogramming'}); }; ...

    Based on The Tao of Programming.

    No 9: The Tragedy of 9/11/2001 by jryan Sep 12 2001 rep:120+

    SHOCK: { fills (my $heart); unbelief (sinks=>'in'); END { my $sorrow; untie my $pain; } } ANGER: { fills (my $heart); curse $the{Dancers}; kill $the{Guilty}; DESTROY {$the{Mastermind}} } GRIEF: { fills (my $heart); bless $the{Dead}; thank (@{$the{Volunteers}}); BEGIN {a new()} } # structure: There are no structures; they have all collapsed. # use strict: There is no discipline; only chaos of madmen. # warnings: There is no warnings; there WERE no warnings.

    No 8: Ogden Nash, 1902-1971 by VSarkiss Aug 20 2002 rep:120+

    # The Cow # by Ogden Nash # # The cow is of the bovine ilk; # One end is moo, the other, milk. # package cow; @ISA = qw(bovine); push @cow, 'moo'; unshift @cow, 'milk';

    # Reflections on Ice-Breaking # by Ogden Nash # # Candy # Is Dandy # But liquor # Is quicker. package candy; @ISA = qw(dandy); package liquor; 1;

    Sadly, VSarkiss passed away around seven years ago. He contributed many excellent nodes during his time here, including this tribute to Ogden Nash.

    No 7.5: Use strict or unlink it by Jouke Apr 13 2004 rep:130+

    A monk who loved die more than exit
    felt blessed foreach time he could use split
    he pushed and he popped
    he chomped and he chopped
    and warned "Just use strict or unlink it!"

    A clever limerick by Jouke.

    No 7: Bohemian Rhapsody (part 1) by katgirl Jun 13 2002 rep:140+

    require(AirGuitar); if($this eq "real life" | "just fantasy"){ $caught = $in{'a-landslide'}; $no = "\from reality"; } open (YOUR, "$eyes"); $look++ => "the skies" && "c"; $money = 0; $sympathy=0; while ($i, $come, $i, $go){ $i = "easy" } $little++; $little--; if ($wind = "blows") { !$matter => me } $parent = "female"; $me = "murderer"; $gun = head{'man'}; &pull_trigger; if($gun eq "loaded"){ die('man') } tell($parent) => $life = "short"; $life = undef; $parent .- $tears; if (!$back eq this(time)){ $day .+1; } { print "Carry on"; redo; } $matter = 0; if($now eq "too late"){ my $time => "come";} my $spine = $shivers--; $body = $aching . all{'the(time)'}; tell(all) => "bye bye"; @you <= "leave"; $face =~ tr/u/th/; $parent = 000; $i != "want" => die; $i => some(time). s/never/born/ . @all;

    I absolutely love this poem! A brilliant tribute to one of the finest songs of all time, Bohemian Rhapsody.

    Sadly, katgirl has been absent for eight years now and so seems unlikely to write any more poems. Given her outstanding talent, that's a pity.

    No 6.9: Great Perl Literature by petdance Oct 03 2001 rep:140+

    scalar @monte_cristo; sub task { kill( SIGHUP, "mockingbird" ); } $_**(1/2); $_**(1/3); $_**(1/4); for ( @whom ) { toll( chr(7) ); } $nights[11]; sub king { return; } $here..$eternity undef $arms; if ( 1 ) { $postman->ring() for (1..2); } grep /Red October/, @_;

    A quiz in the form of a poem. Which book does each Perl code snippet represent?

    No 6.5: Perl Mambo by jkahn Sep 15 2002 rep:140+

    do # to the tune of 'Mambo'; #5, apologies to Lou Bega our (@syntax) = ('syncopated', 'baby'); sub refrain { my (%little_bit_of) = ('regex' =~ /(matching) (string)/); @ little_bit_of{'shell', 'calls'} = `do_that thing`; $little_bit_of{C} = sub { for(@syntax){ $little_bit_of{sed} =~ s!\\!!g; # "strip backwhacks" } }; @ { $little_bit_of{'OO'}->can('be_nice') } = @ little_bit_of{'lisp', 'lists'} = map {$_} splice(@_); @ little_bit_of{'rich', 'language'} = ('easy', 'puns'); @ { $little_bit_of{'Perl'} } = ('number' => 1); return [instrumental bridge]; }

    To the tune of Mambo No. 5 by Lou Bega.

    No 6.3: Monk Levels by MZSanford Jul 24 2001 rep:150+

    bless \@monks; $initiate = recv(MONASTERY,$enlightenment,$daily,0); $novice = seek(MONASTERY,$enlightenment,0); $acolyte = sleep && eat && study $SOPW && redo; $scribe = require disipline; $monk = print MONASTERY rand($wisdom); $friar = accept(MONASTERY,applause); $abbot = seek(MONASTERY,$enlightenment,2); $bishop = join 'E','d','i','t','o','r','s'; $pontiff = push @monks, $improve; $saint = 1;

    A poetic tribute to the PerlMonks Voting/Experience system.

    No 6.1: I Was a Saint (sung to the tune of "I Will Survive") by sauoq Nov 01 2005 rep:150+

    At first I was afraid, I was petrified
    Kept thinking I could never reach those levels up so high
    Then I spent a few minutes thinking maybe it wouldn't take so long
    And I grew strong
    And I resolved to play along

    And so I'm no longer a Saint
    I just walked in to find that where so many were they now just ain't
    I would have taken that screen shot
    Recorded it for posterity
    If I had known for just one second it'd be gone so suddenly

    To the tune of I Will Survive by Gloria Gaynor.

    Presumably this funny song was composed to get more XP quick in response to Petruchio posting A Level Playing Field the day before. See also: Levels of Monks and Translation of the Perlmonks levels ....

    No. 6: R0z3z 4r3 R3d by dws Mar 10 2001 rep:160+

    Roses are red,
    Violets are blue,
    Taint check your scripts,
    0r 1 w1ll 0wn u.

    Roses are red,
    Tulips are fine,
    Eval that param,
    And u'r b0x w1ll b3 m1n3.

    Roses are funny,
    But this code is a hoot.
    open() that $string,
    And z00n 1'l h4v3 r00t!

    Top 30 Perl Monk dws further clarified the intent of this poem:

    The "l337 sp34k" in the poem alludes to the consequences of deploying poor code, particularly CGIs that don't taint check their parameters. Read it from the point of view of a script kiddie. It's intended to grate on your ears.

    No 5.5: I just want to siiiing! by Petruchio Nov 22 2000 rep:180+

    He's a Perl Hack, and he's okay,
    He hacks all night and he sleeps all day!

    I write my code, I take lunch breaks,
    I go to the Monastery!
    Sometimes I post my homework,
    And merlyn yells at me!

    He writes his code, he takes lunch breaks,
    He goes to the Monastery!
    Sometimes he posts his homework,
    And merlyn yells at... him.

    He's a Perl Hack, and he's okay,
    He hacks all night and he sleeps all day!

    I debug code, I call in sick,
    I stay home and play Doom!
    I write annoying letters
    About MonkMail to vroom!

    To the tune of The Lumberjack Song by Monty Python.

    Quite a bit of interesting PerlMonks history in this ditty ... old homework posts, merlyn, vroom, AgentM and the protracted MonkMail! campaign.

    No 5: The strictures, according to Seuss by toolic May 14 2008 rep:180+

    Do you like use warnings and strict?
    I do not like use warnings and strict.
    Do you like them here or there?
    I do not like them here or there?
    I do not like them anywhere.

    toolic composed this clever Perl tribute to Dr Suess and Green Eggs and Ham.

    No 4: my @chickens by pjf Oct 04 2001 rep:180+

    use Carp qw/cluck/; my @chickens; sleep until $dawn; cluck $loudly until open $coop; exit $coop; chomp $food and accept($scraps,$seed); shift @straw, pop @eggs and cluck $more; until ($dusk) { seek($many,$worms,$bugs); join flock($other,@chickens) if split /from others/; tell WORLD,"sky is falling" if $airplane; } return 2,$coop and sleep until $dawn;

    After quietly contemplating the chickens in his backyard, subsistence farmer and Perl expert pjf wittily summarizes their behavior in just half a page of Perl.

    By the way, pjf is one of the few monks I've met in real life. In addition to running chickens, he has a keen interest in picking and eating wild plants that you won't find in any supermarket.

    No 3: The Doom of the Noldor by Erudil Jun 13 2000 rep:200+

    # The Doom of the Noldor / The Prophecy of the North # J. R. R. Tolkien - Quenta Silmarillion # # Tears unnumbered ye shall shed; # and the Valar will fence Valinor against you, # and shut you out, # so that not even the echo of your lamentation # shall pass over the mountains. # # On the House of Feanor the wrath of the Valar lieth # from the West unto the uttermost East, # and upon all that will follow them # it shall be laid also. # $_= 'The Doom of the Noldor' or 'The Prophecy of the North'; while( /Doom/ ) { shed("tears "); do { $Valar{'fence_of_Valinor'}++ and $shut_out; } until not( $echo_of_lamentation > $mountains ); for( $West..$uttermost_East ) { map{$_ = $Valar{'wrath'}} (@House_of_Feanor, @followers); } } sub shed{print shift}

    Yet another Erudil classic, this time a Perl poem based on the works of J.R.R.Tolkien.

    No 2: Re: 1st Monasterians by japhy Mar 06 2002 rep:240+

    substr("Erudil to the Monasterians", 0, 1); 1 . Erudil->isa(PerlHacker) .. [ "vroom", @saints, @monastery ]; 2 . undef $^W, close(STDERR) and !$! for 1..100; 3 . -M Erudil > 2*365 and $appreciation{$_}++ for qw( place custodians members ); 4 . do { for (@brothers, @sisters) { listen up, hearken } continue { to: wait() and study() for grep !clue($_) && ignorant($_), Visitors- To-Our-Blessed-Monastery } }; 5 . do { not rebuke($words{harsh} =~ /RTFM/), but }, lead-with-URLs if wisdom->isa( goal-of-theirs); 6 . allow for newbies and instruct(grep $_, @contents); 7. for 0 < grep errant || ignorant, @us; 8 . consider; these: 9 . ($^H & 0x602) and bless($they), for typos < troubles; 10 . $^W and bless($they), for $errors -> (0); 11 . %CGI:: and bless($they), for eval { pass-parameters } and not $@; 12 . eval "use CPAN; 1" and bless($they), for $wheels_not_reinvented > 1e9; 13 . qr// and bless($they), for HTML-time == 0; 14 . insults? ridicule? blessed: are: you, for time and effort < theirs; 15 . grep refuser($_), @those ? (do { not allow flame wars } or disrepute): yourselves or Monastery; 16 . study well::, $$ = 0 for grep cool lost, grep flamewar winner, @men; time < age-of-reason and 17 . those who suffer thus, do { consider: like me, close mouth, select words, carefully, to edify, to inform }; 18 . $_++ for @brothers, @sisters, restorers-of-faith and $^T = time, 19 . good-syntax and efficient- algorithms; 20 . eval { $$ref; 1 } and study, study Perl, study bless$ed, Perl; 21 . Amen and amen;

    japhy converts Erudil's 1st Monasterians masterpiece into a Perl poem.

    No 1: Fish dinner by suaveant Jun 04 2001 rep:320+

    use Carp; unpack fish, spices; croak fish if $alive; study recipe, pop in, time; BEGIN {meal}; tied %bib; scalar fish; fork, split; sqrt lemon; glob tartarsauce; chop, open(MOUTH), chomp; unlink flesh; truncate bone, chomp; untie %bib; push plate; END {meal}; sleep now;

    I found this really funny and upvoted it without hesitation when I first set eyes on it years ago. Admittedly, suaveant marketed this node relentlessly by making it part of his sig. I still feel this is a very worthy number one, a fantastic poem.

    Since reading this poem, I always pronounce the sqrt function as "squirt". :)


    Updated Dec 27 2014: Added poem 5.5, poem 6.1, poem 6.3, poem 6.5 poem 6.9, poem 7.5, poem 9.3 which I had missed in my original post (thanks tye). Omitted 6.7 as it is a poetry competition, not a poem.

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (10)
As of 2014-12-27 16:47 GMT
Find Nodes?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?

    Results (177 votes), past polls