good chemistry is complicated,and a little bit messy -LW PerlMonks

by larsen (Parson)
 on Jun 02, 2004 at 14:39 UTC 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->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";
}

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

### 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>
[%
# 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 =~ 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}){
+<br />";
\$str .= linkNode(\$NODE, 'Edit', {displaytype => 'edit'}) .
}
%]

### 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?)

Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (3)
As of 2022-08-17 07:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?