Manipulating a Hash-of-Hashes (for meirgold)
# typical hash-of-hashes:
my %hash = ( a => { b => 2 },
c => { b => 4 } );
$hash{$key1}{$key2} = $value;
If you want all the details:
while ( my ( $outer_key, $outer_value ) = each %hash )
{
while ( my ( $inner_key, $inner_value ) = each %$outer_value )
{
# do whatever...
}
}
If you just want a list of inner keys, you can get them
either with duplicates or without:
# with dups
my @inner_keys = map { keys %$_ } values %hash;
# without dups
my @uniq_inner_keys = do
{
my %inner_keys;
while ( my ( undef, $href ) = each %hash )
{
@inner_keys{ keys %$href } = ();
}
keys %inner_keys;
};
Function calls in eval (for mutated)
perl -lwe 'sub f { my $n = shift;
return $n < 2 ? 1 : $n * f($n-1); }
print f(7);
eval { print f(8); };
if ( $@ ) { print "eval failed: $@" }'
Works just as expected.
And a harness for running it multiple times:
#!/bin/bash -x
cp mutated-orig.plx mutated1.plx
for i in 1 2 3 4
do
this=mutated$i.plx
echo ';' >> $this
echo 'if ( $@ ) { print "eval: $@" }' >> $this
perl -MO=Deparse $this | ./mut-dewhack.plx > m$i.pre-parse
perl $this > m$i.out 2> m$i.err
perl -MO=Deparse $this | ./mut-dewhack.plx > m$i.post-parse
next=mutated$(( $i + 1 )).plx
cp $this $next
done;
I don't get the "gm not found" error, though. Adding
if ( $@ ) { print STDERR "eval failed: $@" }
to the end of the first output iteration gives me
these errors:
./mutated1.plx: eval: line 1: unexpected EOF while looking for matchin
+g `"'
./mutated1.plx: eval: line 2: syntax error: unexpected end of file
./mutated1.plx: line 4: syntax error near unexpected token `.'
./mutated1.plx: line 4: `('`'|'-').('['^'"').('{'^'[').'\\$'.('`'|'-')
+.('['^'#').('{'^'[').'='.('{'^'[').('^'^('`'|')')).('^'^('`'|'.')).('
+^'^('`''
Cascaded commands in shell scripts
cmd1 arg1 arg2 arg3 && \
cmd2 arg arg arg pirate arg arg arg
An actual example. We look for any directory
in the current dir, try to create a new tar file
out of it; if (and only if!) that creation succeeded,
blow away the original directory
foreach d in $( find . -type d -depth 1 -print )
do
tar czf $d.tar.gz $d && \
rm -rf $d
done
Multiple bracket fun
$ perl -lwe '$_="[http://a|alpha] [http://b|beta]";
print;
s{\[(http://.+?)\|(.+?)\]}
{<a href="$1">$2</a>}gi;
print'
[http://a|alpha] [http://b|beta]
<a href="http://a">alpha</a> <a href="http://b">beta</a>
Let the title be optional:
$ perl -lwe '$_="[http://a|alpha] [http://b|beta] [http://g]";
print;
s{ \[ (http://.+?)
(?: \| (.+?) )? \] }
{ qq!<a href="$1">! .
(defined $2 ? $2 : $1) .
qq!</a>\n! }giex;
print'
[http://a|alpha] [http://b|beta] [http://g]
<a href="http://a">alpha</a>
<a href="http://b">beta</a>
<a href="http://g">http://g</a>
Ok, that's fugly (and I'm not entirely sure that
I'm guarding my eval-able stuff properly!).
How about we just use two different substitutions,
one with title and one without?
$ perl -lwe \
'$_="[http://a|alpha] [http://b|beta] [http://g]";
print;
# match with title
s{\[(http://[^\]\|]+)\|([^\]]+)\]} {<a href="$1">$2</a>\n}gi;
# match without title
s{\[(http://[^\]\|]+)\]} {<a href="$1">$1</a>\n}gi;
print'
[http://a|alpha] [http://b|beta] [http://g]
<a href="http://a">alpha</a>
<a href="http://b">beta</a>
<a href="http://g">http://g</a>
Pad to next multiple of 16 bytes
my $x = join("", 0..9)x2;
my $lx = length($x);
my $next_mult = ($lx + 15) & ~0x0f;
$x .= "*" x ($next_mult - $lx);
print "|$x|\n"'
Link to target in documentation
[doc://perlfunc#shift] maybe:
shift
=item $self->add_manufacturer( %args );
Adds a manufacturer to the database. Required keys
in %args:
company_id
company_name
address
city
state
zip
contact
phone
fax
email
account_number
Returns the new manufacturer id.
=cut
sub add_manufacturer
{
my ( $self, %args ) = @_;
# make sure we have all required keys
my @cols = qw( company_id company_name
address city state zip
contact phone fax email
account_number );
if ( my @missing = grep { ! exists $args{$_} } @cols )
{
die "add_manufacturer: missing args @missing";
}
# build up the SQL. to make more efficient, do
# this only once and stash it somewhere.
my $cols = join ',', ( 'id', cols );
my $places = join ',', ( '?' ) x ( 1 + @cols );
my $sql = "INSERT INTO sf_manufacturers ( $cols )" .
" VALUES ( $places )";
# do the actual insertion here.
$self->{dbh}->do( $sql, {}, undef, @args{@cols} );
# still need to get actual new id here...
return $self->{dbh}->get_latest_insert_id();
}
Suggested subroutine documentation style
=item my $prefix = shortest_prefix @strings;
Return the shortest prefix common to all @strings. Returns empty
string if there is no prefix; returns C<undef> if there are no strings
or if any of the values are themselves C<undef>
=cut
# algorithm by Ilya Z
# implementation by Ken Fox
# both ganked from c.l.p.misc:
# http://groups.google.fm/groups?selm=199908100340.UAA13944%40long-lak
+e.nihongo.org
sub common_prefix ( @ )
{
defined( my $prefix = shift ) or return undef;
my $len = length $prefix or return '';
foreach my $w ( @_ )
{
defined $w or return undef;
while ( substr( $w, 0, $len ) ne $prefix )
{
--$len;
chop $prefix;
}
$len or return '';
}
return $prefix;
}
My crazy SQL indentation style(s)
SELECT *
FROM my_table AS t,
( SELECT MAX( date ) AS max_date
FROM my_table ) AS s
WHERE t.date = s.max_date;
Here is what the C++ standard (1998) has to say
about integral types (§3.9.1.2):
There are four signed integer types: signed char, short int, int, and long int. In this
list, each type provides at least as much storage as those preceding it in the list. Plain ints have the natu-
ral size suggested by the architecture of the execution environment(39) ; the other signed integer types are
provided to meet special needs.
As for how to get the max value for a particular type (§§18.2.1.2.1-5):
#include <limits>
int max_int = std::numeric_limits<int>::max();
dhoss: does this not work?
href="...&session=<TMPL_VAR ESCAPE="HTML" NAME="session">&mod=<TMPL_
+VAR ESCAPE="HTML" NAME="mod">&..."
for alternating colors:
<tr <TMPL_IF NAME="__odd__">
bgcolor="<TMPL_VAR NAME="odd_color" ESCAPE="HTML">"
<TMPL_ELSE>
bgcolor="<TMPL_VAR NAME="even_color" ESCAPE="HTML">"
</TMPL_IF> >
|