Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

JadeNB's scratchpad

by JadeNB (Chaplain)
on Aug 20, 2008 at 18:19 UTC ( [id://705579]=scratchpad: print w/replies, xml ) Need Help??

The following is my attempt at some benchmarking code for DAGolden's pairwise list-reduction question. I've updated it to include calling as opposed to ‘inlining’ a function; the version called my in my comment is what is called inline_kvmap here.
use Benchmark qw/cmpthese/; use List::Util qw/reduce/; sub kvmap (&@) { my ( $f, @kv ) = @_; my $key = 0; local ( $a, $b ); return map { ( $key ^= 1 ) ? do { $a = $_; () } : do { $b = $_; $f->($a, $b +) } } @kv; } my @data = my %data = ( action => 'submit', type => 'comment', message => 'Hello' ); cmpthese -5, { ex1 => sub { my @output; while ( my ($k,$v) = splice(@data,0,2) ) { push @output, "$k=$v" } join( "&", @output ); }, ex2 => sub { my @output; my @copy = @data; while ( my ($k,$v) = splice(@copy,0,2) ) { push @output, "$k=$v" } join( "&", @output ); }, ex3 => sub { my @output; while ( my ($k,$v) = each %data ) { push @output, "$k=$v" } join( "&", @output ); }, ex4 => sub { join "&", map { "$_->[0]=$_->[1]" } map { @$_ } reduce { ! @$a || ref $a->[-1] ? push @$a, $b : push @$a, [pop @$a, + $b]; $a } [], @data; }, ex5 => sub { join "&", map { @{$_->[0]} } reduce { ref $a->[-1] ? push @$a, $b : push @{$a->[0]}, pop(@$a) . +"=$b"; $a } [[]], @data; }, inline_kvmap => sub { my $key = 0; local ( $a, $b ); join '&', map { ( $key ^= 1 ) ? do { $a = $_; () } : do { "$a=$_" } } @data; }, call_kvmap => sub { join '&', kvmap { "$a=$b" } @data; } };

sub TIESCALAR { bless \my $o => $_[0] } sub STORE { $_[1] = "Touched by STORE\n" } tie my $a => 'main'; my $b = "Untouched by STORE\n"; $a = $b; print $b; # => Untouched by STORE tied($a)->STORE($b); print $b; # => Touched by STORE
When invoked ‘automatically’, does STORE receive as its second argument a copy of the right-hand side of the assignment that invoked it? Is this documented anywhere?
What follows is ancient. I keep it for sentimental value.
hacker asked for a way to walk an arbitrarily nested data structure, stringifying all blessed objects along the way. Here's a stab at it.
sub walk { my ( $ref ) = @_; return "$ref" if blessed $ref; given ( ref $ref ) { when ( '' ) { return $ref; } when ( 'ARRAY' ) { return map { walk($_) } @$ref; } when ( 'HASH' ) { return map { $_ => walk($ref->{$_}) } keys + %$ref; } default { carp "I'm confused by $ref" } } }
A more general version would be
{ my ( $test, $modify ); sub walk { my $ref; ( $test, $modify, $ref ) = @_; ref $modify eq 'CODE' and ref $test eq 'CODE' or croak 'First 2 a +rguments must be coderefs'; return _walk($ref); } sub _walk { my ( $ref ) = @_; return $modify->($ref) if $test->($ref); given ( ref $ref ) { when ( '' ) { return $ref; } when ( 'ARRAY' ) { return map { _walk($_) } @$ref; } when ( 'HASH' ) { return map { $_ => _walk($ref->{$_}) } key +s %$ref; } default { carp "I'm confused by $ref" } } } }
You could then get the original functionality by calling walk(sub { blessed $_[0] }, sub { "$_[0]" }, $ref).
Limbic~Region asked an interesting question in the Chatterbox today: If I only get to pass in the regex in $rx to some code that contains the command
my ( $gold ) = $data =~ /$rx/
—in particular, if I have no access to $gold or $data—then how can I pretend that every occurrence of 'foo' in $data is actually 'bar'? The following scary regex (which relies on the literal strings 'foo' and 'bar' being of the same length) seems to work, if you're trying to match qr/(bar).*(bar)/:
qr/(foo).*(foo)(?{ $_ =~ s+foo+bar+g })/
. In general, one can write something like
use re 'eval'; my $rx = qr/$rx_with_foo(?{ $_ =~ s+foo+bar+g })/
We happen to be so lucky that we only need re 'eval' to make the regex $rx—once that's done, we can pass it into the faulty code, which itself need not use re 'eval'.

UPDATE: Oops, the code below works. Now I'm trying to break it again.

I'm trying to understand exactly what kind of object is returned by fields::new. The following code doesn't do what I expect:

{ package A; use fields qw/a/; sub new { return fields::new(shift); } sub legal_keys { my ( $self ) = @_; print $self, "\n"; return Hash::Util::legal_keys $self; } } my $a = A->new; print $a->legal_keys, "\n"; print $a, "\n"; print Hash::Util::legal_keys($a), "\n";
(Sorry about the formatting; I'm not sure how to indent when the browser eats any tabs and 
 is taken literally inside a code block.) It seems to me that calling the method legal_keys on $a, and directly passing $a to the function Hash::Util::legal_keys, should be doing the same thing. However, the first one works fine, and the second one dies with message 'Type of arg 1 to Hash::Util::legal_keys must be hash (not private variable) at ... near "$a)"'. If I remove the 'my' before $a (invoking the wrath of strictures), then I get instead 'Type of arg 1 to Hash::Util::legal_keys must be hash (not scalar dereference) at ... near "$a)"'.

If I comment out the last line, then everything works fine. In particular, the calls print $a and print $self print exactly the same thing, which shoots down my initial theory that maybe the first argument to a function called as a method is actually an unblessed copy of its invocant, or something. If I remove the scope brackets around package A, so that the call Hash::Util::legal_keys $a is made in that package, then again it works fine—so I guess that that's the point. Can anyone explain why the type of a variable looks different in different packages?

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 lurking in the Monastery: (6)
As of 2024-10-10 16:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The PerlMonks site front end has:





    Results (45 votes). Check out past polls.

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.