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' ) );
$_ = 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
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...
# 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";
}
%]
#!/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?)
|