Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

tkil's scratchpad

by tkil (Monk)
on Jun 01, 2004 at 19:52 UTC ( [id://358489]=scratchpad: print w/replies, xml ) Need Help??

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

Rewrite of saberworks' example

=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> >
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (4)
As of 2024-03-28 21:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found