Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
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 studying the Monastery: (14)
As of 2014-08-27 20:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (252 votes), past polls