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 13
           Re6 g6 14 Nb5 Ne8 15 Be2 a6 16 Qa3 g5 17 Na7+!! Qxa7 18  Rxc6+! bxc\
6 19 Bxa6+ Qb7 20 Qa5
|;

s{\b(\d+)\b}{\1.}g;

print;

##

##

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 "List mode\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 "Item mode\n";
}

sub fetch_image
{
    print "Fetch_image mode\n";
}


##

##

# Modified by larsen - Nov 17 2001



[%
	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(
		
	);
%]



		
		 
[%
	use Everything::Experience;
	if ($NODE->{imgsrc} and getLevel($NODE)<5 and !isGod($NODE))
		return linkNodeTitle("I want my picture back|*");
	return "";
%]




	
	User since:
	[{parsetime:createtime}]
	

	
	Last here:
	[{parsetime:lasttime}]
    	([{timesince:$NODE->{lasttime}}])
	

	
	Experience:
	
    	[% $NODE->{experience} || "none yet" %]
	
	

	
	Level:
	
	[%  
		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)";
    %]
	
	
	

	
	Writeups:
	
	
	[%
    	my $count = htmlcode('displaySingleVar', 'numwriteups');
        $count ||= 0;
        my $title = $NODE->{title};
        $title =~ s/ /\+/g;
        "$count"; 
    %]
	
	

	
	Location:
	[{displaySingleVar:location}]
	

	
	User's localtime:
	
	[%
		my $USERVARS = getVars($NODE);
		htmlcode('userlocaltime', $USERVARS->{timezone});
	%]
	
	

	
	User's scratchpad:
	
	[%
		# crazyinsomniac Sat Nov  3 00:39:08 2001 GMT

		my $USERVARS = getVars($NODE);

		if($$USERVARS{scratchpublic})
		{
		    return qq( this pad be public, scratch it);
		}
		else {   
			return "not public";  
		}
	%]
	
	

	
	





[%
	use Everything::Experience;
	my $str;
	$str .= htmlcode('parselinks', 'doctext,override');
	$str =~ s///igs 
          unless(getLevel($NODE)>=5 or isGod($NODE));
	$str =~ s/]*>.*?<\/script[^>]*>//igs if $$USER{jsoff};
	$str;
%]

[% if(getId($USER) == getId($NODE) and getId($USER) != $HTMLVARS{default_user}){ my $str .= "Change your " . linkNodeTitle("user settings") . " "; $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")