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

larsen's scratchpad

by larsen (Parson)
on Jun 02, 2004 at 14:39 UTC ( #359463=scratchpad: print w/ replies, xml ) Need Help??

for bronto

use strict; use warnings; use Quantum::Superpositions; use Test::More qw/no_plan/; $|++; my %corr = ( a => any( 'a', '@', '4' ), b => any( 'b', '6', '8', '&' ), d => any( 'd', '0' ), e => any( 'e', '3', '&' ), g => any( 'g', '9' ), i => any( 'i', '1', 'l' ), j => any( 'j', '1' ), l => any( 'l', '1' ), o => any( 'o', '0' ), p => any( 'p', '9' ), q => any( 'q', '9' ), s => any( 's', '$', '5' ), t => any( 't', '+' ), z => any( 'z', '2', '7', '%' ) ); sub compare_strings { my $s1 = shift; my $s2 = shift; my @c1 = split //, lc $s1; my @c2 = split //, lc $s2; @c2 = map { exists $corr{ $_ } ? $corr{ $_ } : $_ } @c2; print "c1: @c1\nc2: @c2\n"; my $res = 1; for ( my $index = 0; $index < scalar @c1; $index++ ) { $res = $res && ($c1[ $index ] eq $c2[ $index ]); } return $res; } ok( 'a' eq any( '4', 'a', '@' ) ); ok( compare_strings( 'l4rsen', 'larsen' ) ); ok( compare_strings( 'b4rsen', 'larsen' ) ); ok( compare_strings( 'b4rsen', 'larsen' ) ); ok( compare_strings( 'm@rc0m4r0n91u', 'marcomarongiu' ) );

for princepawn

$_ = qq| 1 d4 f5 2 Nc3 d5 3 Bg5 c6 4 e4 fxe4 5 f3 exf3 6 Nxf3 Bg4 7 h3 + Bxf3 8 Qxf3 Nf6 9 Bd3 Nbd7 10 0-0-0 Qc7 11 Rhe1 0-0-0 12 Bf4 Qb6 1 +3 Re6 g6 14 Nb5 Ne8 15 Be2 a6 16 Qa3 g5 17 Na7+!! Qxa7 18 Rx +c6+! bxc\ 6 19 Bxa6+ Qb7 20 Qa5 |; s{\b(\d+)\b}{\1.}g; print;

http://www.welie.com/patterns/gui/index.html

for Dogma

Using CGI::Application. Now some code...
use strict; use CGI; use Template; $|++; # Dispatch table is a hash where # every value is a sub-reference # When the user doesn't provide # a run-mode, then list() is # triggered (default case, see # the last line my %dispatch_table = ( list => \&list, item => \&item, fetch_image => \&fetch_image, '' => \&list, ); my $query = new CGI; print $query->header; print $query->start_html( -title => 'A small example...' ); # Now we read the param mode from # the query. The string is used to # fetch the hash table. We got a # reference to a function, so we # can call it... my $mode = $query->param('mode'); &{ $dispatch_table{$mode}}; print $query->end_html; sub list { print "<h1>List mode</h1>\n"; my $action = $query->param('action'); # What we can do with $action? # Another dispatch table here is not # possible (one can't define procedures # local to other procedures, like in # Pascal). Another possibility is to # define other procedures "at the same # level" of list(), item() and so on... # but it isn't elegant and easily maintanable. # So we could use different # packages for different "top level run-modes". # Or, simply, we can cope with $action # here, with a if-elsif-else construct. } sub item { print "<h1>Item mode</h1>\n"; } sub fetch_image { print "<h1>Fetch_image mode</h1>\n"; }

Random links...

The Drama of Being a Developer I - Heroism, Specifications, and testing with the right mice.
http://www.perlmonks.org/index.pl?displaytype=viewcode&node_id=108949
SIGDIE

PmDev Stuff

Useful resources for pmdevs

Nodes for which I've submitted a patch so far...


A silly patch for user display page

# Modified by larsen - Nov 17 2001 <table> <tr> [% use Everything::Experience; return unless $NODE->{imgsrc}; my $SETTING = getNode('home node image cheaters','setting'); my $CHEATERS = getVars $SETTING; return unless isGod($NODE) or getLevel($NODE) >= 5 or $CHEATERS->{$NODE->{title}} or $CHEATERS->{$NODE->{node_id}}; return qq( <td rowspan="10"> <img src="http://perlmonks.org/$NODE->{imgsrc}"> </td> ); %] <td valign="top"> [% use Everything::Experience; if ($NODE->{imgsrc} and getLevel($NODE)<5 and !isGod($NODE)) return linkNodeTitle("I want my picture back|*"); return ""; %] <br /> <table> <tr> <td>User since:</td> <td>[{parsetime:createtime}]</td> </tr> <tr> <td>Last here:</td> <td>[{parsetime:lasttime}] <i>([{timesince:$NODE->{lasttime}}])</i></td> </tr> <tr> <td>Experience:</td> <td> <b>[% $NODE->{experience} || "none yet" %]</b> </td> </tr> <tr> <td>Level:</td> <td><b> [% use Everything::Experience; my $lvl = getLevel($NODE); my $LT = getVars(getNode('level titles', 'setting')); my %is_inquisitor = (); # larsen - Nov 17 2001 # Maybe an hash here is overkill. # Since there are only two Inquisitors, # a simple OR clause could be fine. foreach( qw|larsen OeufMayo| ) $is_inquisitor{ $_ }++; my $leveltitle; if ($is_inquisitor{ $NODE->{title} }) { $leveltitle = 'Inquisitor'; } else { $leveltitle=$LT->{$lvl}; } return $leveltitle . " ($lvl)"; %] </b> </td> </tr> <tr> <td>Writeups:</td> <td> <b> [% my $count = htmlcode('displaySingleVar', 'numwriteups'); $count ||= 0; my $title = $NODE->{title}; $title =~ s/ /\+/g; "<a href=" . urlGen({ node => 'Perl Monks User Search', usersearch => $NODE->{title}, orderby => 'createtime DESC'}) . ">$count</a>"; %]</b> </td> </tr> <tr> <td>Location:</td> <td>[{displaySingleVar:location}]</td> </tr> <tr> <td>User's localtime:</td> <td> [% my $USERVARS = getVars($NODE); htmlcode('userlocaltime', $USERVARS->{timezone}); %] </td> </tr> <tr> <td>User's scratchpad:</td> <td> [% # crazyinsomniac Sat Nov 3 00:39:08 2001 GMT my $USERVARS = getVars($NODE); if($$USERVARS{scratchpublic}) { return qq( <a href="/index.pl?node_id=108949&user= ) . $query->escape($NODE->{title}) . qq(">this pad be public, scratch it</a>); } else { return "<i>not public</i>"; } %] </td> </tr> </table> </tr> </tr> </table> <p> [% use Everything::Experience; my $str; $str .= htmlcode('parselinks', 'doctext,override'); $str =~ s/<img(\n|.)*?src\s*=.*?>//igs unless(getLevel($NODE)>=5 or isGod($NODE)); $str =~ s/<script[^>]*>.*?<\/script[^>]*>//igs if $$USER{jsoff}; $str; %] <p> [% if(getId($USER) == getId($NODE) and getId($USER) != $HTMLVARS{defa +ult_user}){ my $str .= "Change your " . linkNodeTitle("user settings") . " +<br />"; $str .= linkNode($NODE, 'Edit', {displaytype => 'edit'}) . " your user information"; } %]

for dree

#!/usr/bin/perl use strict; use warnings; package Foo; # un package finto... sub bar { my $code_ref = shift; my $str1 = shift; my $str2 = shift; return \&$code_ref( $str1, $str2 ); } # Una funzione finta, che si aspetta di ricevere una # reference ad una funzione che vuole un paio di stringhe # e restituisce qualcosa (uno scalare, in questo caso) package main; # Chiuso il package Foo, si passa a main # Che contiene... sub mySub1 { my $str1 = shift; my $str2 = shift; print "mySub1: $str1 $str2\n"; } # mySub1(), una sub che vuole solamente un paio di stringhe... sub mySub2 { my $array_ref = shift; my $str1 = shift; my $str2 = shift; print "mySub2: $str1 $str2 @$array_ref\n"; } # ... e mySub2(), che oltre alle stringhe vuole che le sia # passata una ref ad un array: # Il problema e`, a questo punto, costruire due ref da # passare a Foo::bar(), a partire dalle due funzioni, che # come e` stato detto hanno una signature differente... my $ref1 = \&mySub1; Foo::bar( $ref1, 'pippo', 'pluto' ); # per la prima funzione non c'e` problema... # Per la seconda funzione my $ref2; { my $array_ref = [1, 2, 3]; $ref2 = sub { mySub2( $array_ref, shift, shift ); }; } # $ref2 e` una closure, cioe` una sub anonima che fa # riferimento a variabili lessicali che erano visibili # al momento della sua creazione. In questo caso $array_ref. Foo::bar( $ref2, 'pippo', 'pluto' ); # Non sono ancora sicuro che le cose si facciano cosi`. # Leggi la doc (e il codice) di Attribute::Curried, oltre # a perldoc perlref ("Function Templates")

Re: Where/When is OO useful?
Resorting to Sorting
Combining Ultra-Dynamic Files to Avoid Clustering (Ideas?)
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 pondering the Monastery: (9)
As of 2015-07-29 23:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (269 votes), past polls