Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical

shmem's scratchpad

by shmem (Chancellor)
on Mar 09, 2006 at 10:35 UTC ( #535366=scratchpad: print w/replies, xml ) Need Help??

pragmatic pragma

Draft of a meditation. Make arbitrary modules pragmatic, i.e. lexically scoped.

package Foo; require Exporter; @Foo::ISA = qw(Exporter); our @EXPORT = qw(foo); sub foo { print "Foo::foo\n" } 1;
#!/usr/bin/perl # sub foo { print "main::foo\n"; } use pragmatic Foo; foo; no pragmatic Foo; foo; use pragmatic Foo; foo; no pragmatic; foo; use pragmatic Foo; foo;
package pragmatic; our $VERSION = 0.01; our %pragmas; # pragmas currently in effect our %masked; # masked symbols while pragma on our %symbols; # our $AUTOLOAD; sub import { shift; # discard package return unless @_; # nothing to do my ($mod,@args) = split " ", shift; my @caller = caller(1); # see if $mod is defined in $caller my $callpkg = $caller[0]; unless (exists $symbols{$callpkg} && exists $symbols{$callpkg}->{$ +mod}) { package pragmatic::import { die $@ unless eval "use $mod @args;1"; my $stash = "$callpkg\::"; for my $symbol (keys %pragmatic::import::) { if (my $code = *{$pragmatic::import::{$symbol}}{CODE}) +{ next unless *{${$stash}{$symbol}}; if (*{${$stash}{$symbol}}{CODE}) { $masked{$callpkg}->{$symbol} = *{${$stash}{$symbol}}{CODE}; } $symbols{$callpkg}->{$mod}->{$symbol} = $code; *{"$caller\::$symbol"} = \&{"pragmatic::$symbol"}; } delete $pragmatic::import::{$symbol}; } } } push @{$pragmas{$callpkg}}, $mod unless grep {/^$mod$/} @{$pragmas{$callpkg}}; $^H{"$callpkg/pragma/in_effect"} = 1; $^H{"$callpkg/$mod/in_effect"} = 1; } sub unimport { shift; my $mod = shift; my $callpkg = (caller)[0]; if($mod) { $^H{"$callpkg/$mod/in_effect"} = 0; } else { $^H{"$callpkg/pragma/in_effect"} = 0; } } sub AUTOLOAD { $AUTOLOAD =~ s/.*:://; my ($callpkg,$file,$line,$hinthash) = (caller(0))[0..2,10]; if ($hinthash->{"$callpkg/pragma/in_effect"}) { # look up symbol in reverse pragma chain for this package for my $mod ( reverse @{$pragmas{$callpkg}} ) { if (exists $symbols{$callpkg}->{$mod}) { if (exists $symbols{$callpkg}->{$mod}->{$AUTOLOAD}) { if ($hinthash->{"$callpkg/$mod/in_effect"}) { goto &{$symbols{$callpkg}->{$mod}->{$AUTOLOAD} +}; } else { goto &{$masked{$callpkg}->{$AUTOLOAD}}; } } } } die "Undefined subroutine &$callpkg::$AUTOLOAD called at $file + line $line\n"; } else { goto &{$masked{$callpkg}->{$AUTOLOAD}}; } } 1;

for LanX about internal DSL

Some thoughts, using the very neat tmoertel meditation, and my derived module.

  1. the DSL should be written and executed as perl code
  2. the DSL should work fine with any other valid perl code interspersed within it
  3. the scope of the DSL code should be delimited. In this case, it is included in a block provided to the render() funtion, which is fine
  4. the functions neccesary for the DSL should not pollute the caller's namespace.
  5. the DSL should be performant

Point 4 is the biggest thing here. The DSL scope is already confined via the block as argument to render, which happens to be compiled into the scope of the code using it. This call could be wrapped into a package proper, but maybe it is feasible to use lexical subs inside the block render() consumes. I'll give that a try.

Basic steps to make a distribution from a bunch of module files (say, Date/Birth/*.pm):

  • run h2xs -X -A Date::Birth in the directory where you want to setup the dist directory.
    This generates stubs for the module. Then cd Date-Birth
  • copy your Date/Birth/*.pm files to lib/Date/Birth/
  • edit MANIFEST and add those files
  • edit README
  • you may want to modify lib/Date/ to include
    use Date::Birth::Stone; use Date::Birth::Flower; use Date::Birth::DayStone; use Date::Birth::ZodiacStone;
    and export the symbols it just imported from Date::Birth::*
  • you may want to modify the t/Date-Birth.t file and add more tests
  • run perl Makefile.PL
  • run make test
  • run make dist

Done. You will find a Date-Birth-0.01.tar.gz in your current directory.

Why does this yup?

#!/usr/bin/perl use Encode; use strict; use warnings; # avoid being beaten to death no warnings "experimental::regex_sets"; my $european_chars_iso8859 = join '', map { chr $_ } (191..207,209..21 +4,216,217..221,223..239,241..246,248..253); my $european_chars_utf8 = encode_utf8(decode('latin1',$european_cha +rs_iso8859)); my $european_chars = "[$european_chars_iso8859] + [$european_chars_utf +8]"; my $valid = "[:print:] + $european_chars"; print "yup\n" if chr(0x82) =~ /^(?[$valid])+$/; __END__ yup

XP in hex, Free Nodelet Settings

<script type="text/javascript"> item = document.evaluate("//center/table/tbody/tr/td`[1]/table`[1]/tbo +dy/tr/td`[2]/table/tbody/tr`[4]/td`[2]/b",document, null, XPathResult +.ORDERED_NODE_SNAPSHOT_TYPE,null).snapshotItem(0); if(item) item.innerHTML = "0x" + parseInt(item.innerHTML).toString(16) +; </script>

#!/usr/bin/perl use strict; my $pat = shift; my $p; { my (%s, %i); my $d = my $c = 1; # our regexp will be inside parens, so first back +ref is 2 $p = join ( "", map { if($s{$_}++){ "\\".$i{$_} } else{ $i{$_}=++$c; $c>$d+1 ? '(?!'.join('|',map{"\\".abs}-$c+1..-$d-1).")(\\w)" : + "(\\w)"; } } split//,$pat ); } print '(',$p,")\n"; open my $fh, '<', shift; my %s; while (<$fh>) { my @l = (); while (/\b($p)\b/g) { push @l, $1 unless $s{$1}++; } print join (", ",@l), $/ if @l; }

try: perl fusselkerl /usr/share/dict/words

For Lady Aleena

The name attribute is to be used on button, fieldset, form, iframe, input, keygen, map, meta, object, output, param , select, and textarea. Using the name attribute on anything else will lead to poor HTML.

You forgot a which is the most common tag for which the name attribute is valid. <a></a> is anchor and it is used as <a href="$url">link text</a> and <a name="anchor_name">anchor in text</a> to mark an anchor in a page whose href would then be <a href="$url#anchor_name">target text</a>.

So, For Lady_Aleena ([href://?node_id=535366#Lady_Aleena|For Lady_Aleena]) links to the copy of this node marked as <a name="Lady_Aleena">For Lady Aleena</a> on my scratchpad. This is described on What shortcuts can I use for linking to other information?.

You cannot link to a id or to any tag for which the name attribute is valid and set, only to an anchor (<a name="foo">foo</a>).

Sorry for the impromptu lesson on HTML and PerlMonks markup. :-D

perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'
Log In?

What's my password?
Create A New User
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (5)
As of 2017-09-23 10:00 GMT
Find Nodes?
    Voting Booth?
    During the recent solar eclipse, I:

    Results (272 votes). Check out past polls.