##
+---+-+-+
|///|/|/|
|///|/|/|
|///|/|/|
+---+-+-+
|///|/|/|
+---+-+-+
####
{
my %seen;
my %onstack;
my @list;
sub how_to_uninstall {
my $target = shift;
(@list, %seen, %onstack) = ();
_traverse($target);
return @list;
}
sub _traverse {
my $x = shift;
$seen{$x} = $onstack{$x} = 1;
foreach package $y that depends on $x {
die "cyclic!" if $onstack{$y}; # back edge
_traverse($y) unless $seen{$y};
}
push @list, $x;
$onstack{$x} = 0;
}
}
####
PM Markup: Result: paragraphs / line breaks
<p>first paragraph</p>
<p>second paragraph</p>
first paragraph
second paragraph
link to nodes by name
Have you tried [Super Search]?
Have you tried [Super Search]?
Thanks for your help, [tye]
Thanks for your help, [tye]
Thanks for nothing, [tye|wiseguy]
Thanks for nothing, [tye|wiseguy]
link to nodes by ID
Please consult [id://3989]
Please consult [id://3989]
other kinds of links([id://43037|more info])
Check out [pad://NodeReaper]
Check out [pad://NodeReaper]
Did you try [http://google.com|this]?
Did you try [http://google.com|this]?
Did you check [doc://perlfaq]?
Did you check [doc://perlfaq]?
including code in text
The result is in <c>$array[0]</c>
The result is in $array[0]
The code should read:
<c>
use strict;
use warnings;
my @array = ("Hello world\n");
if (@ARGV) {
print $array[0];
}
</c>
The code should read:
use strict;
use warnings;
my @array = ("Hello world\n");
if (@ARGV) {
print $array[0];
}
text/font formatting
This will be <b>bold</b>
This will be bold
This will be <i>italic</i>
This will be italic
This will be <tt>fixed width</tt>
This will be fixed width
quoting / indenting
A wise monk once said:
<blockquote>
"Indenting is good"
</blockquote>
.. and I agree
A wise monk once said:
"Indenting is good"
.. and I agree
lists
My favorite flavors are:
<ul>
<li>vanilla</li>
<li>chocolate</li>
</ul>
My favorite flavors are:
- vanilla
- chocolate
How to make toast:
<ol>
<li>insert bread</li>
<li>press button</li>
</ol>
How to make toast:
- insert bread
- press button
####
# input:
# - env = mapping of variable names to types
# - expr = an expression (AST)
#
# output:
# - type = a type "judgment"
# - constraints = a list of type constraints that must be satisfied
def infer_type( env, expr ):
case expr:
## wow, a literal integer has type IntType!
LiteralIntExpr( thenumber ):
return ( IntType, {} ); # no constraints
## similar rules for other kinds of literals ...
## here's an interesting one:
## empty lists are polymorphic
EmptyListExpr():
return( ListExpr( fresh PolymorphicType ), {} ); # no constriants
## fresh PolymorphicType means make a new PolymorphicType with
## a never-before-used identifying number/letter
## list expression: [item1, ... itemn]
## - infer the type of each item
## - pass along constraints from the subexpressions
## - add constraints that all items have the same type
ListExpr( item1, ... itemn ):
(type1, constr1) = infer_type( env, item1 );
...
(typen, constrn) = infer_type( env, itemn );
## union of these lists of constraints
return ( ListType(type1), constr1 + ... + constrn
+ "type1==type2" + ... + "type1==typen" );
## someone names a variable? if it doesn't have a type
## in our environment, we are hosed! otherwise, the
## environment contains a type mapping for the variable
VariableExpression( varname ):
croak if not exists env{varname};
return ( env{varname}, {} ) # no constraints
## for addition expression:
## - return IntType
## - constrain both args to be IntType
## - pass along constraints from subexpressions
AdditionExpression( subexpr1, subexpr2 ):
(type1, constr1) = infer_type( env, subexpr1 );
(type2, constr2) = infer_type( env, subexpr2 );
## union of these lists of constraints
return (IntType, constr1 + constr2
+ "type1==IntType" + "type2==IntType");
## for concatenation:
## - same as above, but with StrType
ConcatExpression( subexpr1, subexpr2 ):
(type1, constr1) = infer_type( env, subexpr1 );
(type2, constr2) = infer_type( env, subexpr2 );
## union of these lists of constraints
return ( StrType, constr1 + constr2
+ "type1==StrType" + "type2==StrType" );
## list cons expression: i.e,: head::tail
## - return the same type as the tail
## - ensure that the head has the same type as
## tail's elements
ListConsExpression( head, tail ):
(type1, constr1) = infer_type( env, head );
(type2, constr2) = infer_type( env, tail );
return ( type2, constr1 + constr2 + "type2==ListType(type1)" );
## fun var -> body
## - assign var a fresh type
## - infer the type of the body in a modified environment
## - return an appropriate function type
FuncDefExpression( var, body ):
vartype = fresh PolymorphicType;
(bodytype, bodyconstr) = infer_type( env + "var:vartype",
body );
return (FuncType(vartype,bodytype), bodyconstr);
## func(arg):
## - constrain that the argument's type is appropriate
## - this expression's type is the return value type of func
## - easiest to do this by introducing a new polymorphic type
FuncAppExpression( func, arg ):
(type1, constr1) = infer_type( env, head );
(type2, constr2) = infer_type( env, tail );
resulttype = fresh PolymorphicType;
return ( resulttype, constr1 + constr2
+ "type1==FuncType(type2,resulttype)" );
####
# unify a list of constraints:
# - input = list of constraints of the form "lhs==rhs"
# - output = list of constraints
# a unification is an assignment of values to variable that satisfies
# the constraints in the most general way. in our case, variables
# are the PolymorphicType guys, and values are any Types
def unify( constraints ):
return [] if constraints is an empty list;
(lhs,rhs) = shift constraints;
## if they are already equal, do nothing
if lhs = rhs then
return unify(constraints);
## orient "variables" on the lhs
if lhs is not a PolymorphicType, but rhs is, then
(lhs,rhs) = (rhs,lhs);
if lhs = PolymorphicType(id) then
if PolymorphicType(id) occurs anywhere within constraints, then
croak "you're asking for a recursive type!"
constraints = map { replace each PolymorphicType(id)
with rhs } constraints;
## output this assignment as part of the solution!
return "id:rhs" + unify(constraints);
## for 2 FuncTypes to be equal, their components must be equal,
## so add new constraints
if lhs = FuncType(l1,l2) and rhs = FuncType(r1,r2) then
return unify(constraints + "l1==r1" + "l2==r2");
if lhs = ListType(l1) and rhs = ListType(r1) then
return unify(constraints + "l1==r1");
## we get here if you try to constrain a ListType to equal a
## FuncType, or other such impossible feats
else
croak "unification impossible!";
####
## two containers that have the same value
my $x = 1;
my $y = 1;
$x = 5; ## change the value in one container ...
print $y; ## the other container is unaffected
####
my $x = 1;
my $y = \$x; ## $y is a reference to $x
$x = 5;
print $$y;
####
my $x = 0;
sub { $_[0] = 5 }->($x);
print "$x\n";
####
my $x = 0;
my $y = sub { $_[0] }->($x); ## my $y = .. assignment operator
$y = 5;
print "$x\n"; ## still 0
####
my $x = 0;
my $arr = sub { \@_ }->($x);
$arr->[0] = 5;
print "$x\n"; # 5
####
my $arr = do {
my $x;
sub { \@_ }->($x, $x);
};
$arr->[0] = 0;
print "@$arr\n"; ## 0 0
$arr->[0] = 5;
print "@$arr\n"; ## 5 5
####
my $x = 0;
map { $_ = 5 } $x;
print "$x\n";
my $x = 0;
grep { $_ = 5 } $x;
print "$x\n";
####
my $x = 0;
foreach my $y ($x) { $y = 5 }
print "$x\n";
####
my $x = 0;
*y = \$x;
$y = 5;
print "$x\n";
####
my @x = qw(1 2 3 4);
*y = \@x;
splice @y, 2, 1, "hi";
print "@x\n";
####
use Lexical::Alias;
my ($x, $y);
alias $x, $y;
$y = 5;
print "$x\n";
####
my $x = 0;
sub weird { --$_[0]; \@_ }
for my $y (++$x) {
my ($z) = map { weird($_ = 10) } $y;
$z->[0] =~ s/9/hello world!/;
}
print "$x\n";
####
x + (x+b) + ... + (x+(n-1)b) = k
nx + b(1 + 2 + .. + (n-1)) = k
nx + b(n(n-1)/2) = k
####
bn^2 + (2x-b)n - 2k = 0
####
my $p = UnorderedSetPartition->new(
items => ['a'..'f'],
blocks => [2,2,1,1], ## arrayref list of blocks, num of blocks, or omitted=unrestricted
);
my $p = OrderedSetPartition->new(
items => ['a'..'f'],
blocks => [2,2,1,1], ## arrayref list of blocks, num of blocks, or omitted=unrestricted
);
## or perhaps:
## SetPartition->new( ... ordered => 0 ... );
my $iter = $p->iterator(
order => "lex", ## "lex", "colex", "gray", "fastest", etc...
representation => "rg", ## "rg", "AoA", etc..
);
@output = $iter->next;
$iter->skip($n);
$iter->prev; # ??
$iter->reset; ## to the beginning
$iter->reset( $some_saved_rank_or_widget );
####
@output = $p->list( order => "lex", representation => "rg" );
## same as iterator, but returns list of *all* widgets
## maybe allow for a callback
####
$r = $p->rank( order => "lex", representation => "rg", $widget );
$widget = $p->rank( order => "lex", representation => "rg", $r );
## code repetition here?
$how_many_partitions = $p->count;
####
sub binomial {
my ($n, $k) = @_;
my $c = 1;
for (0 .. $k-1) {
$c *= $n-$_;
$c /= $_+1;
}
$c;
}
####
use Memoize;
memoize 'int_partitions';
## number of integer partitions of $N with smallest part $min
sub int_partitions {
my ($N, $min) = @_;
$min = 1 if not defined $min;
## only one way to split up 0
return 1 if $N == 0;
## the smallest item in the partition can be between $min .. $N
## and after we fix it, we need to partition the remaining
## $N-$_, into pieces that must all be >= $_
my $total = 0;
for ($min .. $N) {
$total += int_partitions($N-$_, $_);
}
return $total;
}
print int_partitions(shift), $/;
####
use Memoize;
memoize 'restricted_partitions';
sub restricted_partitions {
my ($N, @coins) = @_;
## can't do it if $N is negative (might get called with $N<0 if
## we have coins bigger than $N)
## only one way to make change for 0
return 0 if $N < 0;
return 1 if $N == 0;
## pick any available coin to be the coin with the lowest ID in this
## partition. once we pick that, we have left to partition $N-$coin,
## and can't use coins with lower IDs to do it...
my $total = 0;
for (0 .. $#coins) {
$total += restricted_partitions($N-$coins[$_], @coins[$_ .. $#coins]);
}
return $total;
}
print restricted_partitions(@ARGV), $/;
####
--- mysqlPP.pm.orig 2005-02-16 23:40:15.000000000 -0600
+++ mysqlPP.pm 2005-02-16 23:41:17.000000000 -0600
@@ -347,10 +347,10 @@
# ...
}
my $statement = $sth->{Statement};
- for (my $i = 0; $i < $num_param; $i++) {
+ {
my $dbh = $sth->{Database};
- my $quoted_param = $dbh->quote($params->[$i]);
- $statement =~ s/\?/$quoted_param/e;
+ my $i = 0;
+ $statement =~ s/\?/$dbh->quote($params->[$i++])/ge;
}
my $mysql = $sth->FETCH('mysqlpp_handle');
my $result = eval {
####
$sth = $dbh->prepare("select * from foo where id=?");
$sth->execute( param("id") );
## execute failed: called with 0 bind variables when 1 are needed
####
# use CGI 'param'; ## not anymore!
use CGI; sub param { scalar CGI::param(@_) }
####
"Robert "Bob" Smith","42","FooBar"
####
use Text::xSV;
sub filter {
local $_ = shift;
chomp;
s/(?<=[^,])\"(?=[^,])/\"\"/g;
"$_\n";
}
my $csv = Text::xSV->new( filename => "...", filter => \&filter );
####
--- xSV-old.pm 2004-05-26 20:13:12.000000000 -0500
+++ xSV.pm 2004-05-26 20:32:48.000000000 -0500
@@ -172,17 +172,18 @@
}
my $sep = $self->{sep};
+ my $quote = $self->{always_quote};
my @row;
foreach my $value (@_) {
if (not defined($value)) {
# Empty fields are undef
- push @row, "";
+ push @row, $quote ? qq("") : "";
}
elsif ("" eq $value) {
# The empty string has to be quoted.
push @row, qq("");
}
- elsif ($value =~ /\s|\Q$sep\E|"/) {
+ elsif ($value =~ /\s|\Q$sep\E|"/ or $quote) {
# quote it
local $_ = $value;
s/"/""/g;
@@ -321,7 +322,7 @@
my @normal_accessors = qw(
close_fh error_handler warning_handler filename filter fh
- row_size row_size_warning
+ row_size row_size_warning always_quote
);
foreach my $accessor (@normal_accessors) {
no strict 'refs';