jdporter's user image
User since: May 30, 2002 at 16:48 UTC
Last here: Nov 29, 2015 at 00:07 UTC (8 hours ago)
Experience: 24743
Level: Canon (20)
Writeups: 2990
User's localtime: Nov 29, 2015 at 03:04 EST
Scratchpad: View
Member of: holders of unholy power, pedagogues, pmdev, QandAEditors, SiteDocClan
For this user:Search nodes

Rooms in my treehouse:
Popular links on homenodes
Tutorials digest
Survey of POOP Modules
Some cb snippets
Restyling PerlMonks
Sitedoclet usage analysis
Scratchpads & Blogs:
pad for admin-related stuff
pad for pmdev-related stuff
pad for other stuff
User Posts
CPAN contribs

Some of my root (and root-like) posts you may find interesting:

PerlMonks for the Absolute Beginner
New Service: Thread Watcher
New Snippets Index
XY Problem
Where should I post Y?
jdporter's place in the name space
test of ancient magic
test this
Nodes 1 .. 1000
There is no Perl Illuminati
PerlMonks Memorial Garden

Also check out my Free Nodelet Hacks
Also check out  
(RFC) Arrays: A Tutorial/Reference
Tk Photo Slideshow, with scrolling and scaling
Simple Console Menuing System
Control and Query Win32 Services at the command line
Strategy Handles
Linked Lists With No Memory Leak
There's Only One Way To Do It
Read and write Windows "shortcut" links
Create and Pop Up Outlook Notes from Perl
IO::MultiHandle - Operate on multiple file handles as one
map-like hash iterator

Here are some links I keep handy in my Free Nodelet:

Free Nodelet Settings
User Settings
Display Settings
Nodelet Settings
log out
PerlMonks statistics
Message Inbox
last hour of cb
Full-Page Chat
Chatterbox statistics

Monks I've met in meatspace:

PerlMonks Quine:

perl -MLWP::Simple -e "getprint 'http://perlmonks.org/?node_id=170442; +displaytype=displaycode'"


Previously, I used this:

Between the mind which plans and the hands which build, there must be a mediator... and this mediator must be the heart.
This is a line (my own translation) from the classic movie Metropolis. Incidentally, my homenode pic above is a frame cap from this movie as well.

In the movie, the building of the mega-city Metropolis is likened to the legendary tower of Babel. This was intended as a warning: Knowing the fate which befell Babel, the builders of the present age should take care to avoid the same sins, and thus the same fate. Specifically, the builders of Babel lacked "heart" (a spirit of compassion and a willingness to compromise), and this resulted in a cataclysmic conflict between management and labor.

Most languages are like StackOverflow: I have a question, I want the best answer.
Perl is like PerlMonks: I have a doubt, I want to read an interesting discussion about it that is likely to go on a tangent. q-:

tye, in Re: What is PerlMonks? (why Perl)

<input type=submit value="border-width=d" " />

Posts by jdporter
get string/array slices using cut-like specifications in Cool Uses for Perl
5 direct replies — Read more / Contribute
by jdporter
on Mar 09, 2011 at 22:50

    The other day in the cb kailas asked how to reproduce the following cut command in perl:

    cut -c2-11,12-61,62-63,64-76,90-92 $str
    Well, reproducing cut in perl is actually not quite as trivial as it seems on first look, because cut can take some pretty hairy specifications, such as descending indices, e.g. 12-8,5,4.

    Here's an attempt to do at least part of what cut can do, in a native perly context of extracting either sub-strings or sub-arrays. It can handle any amount of overlapping and descending ranges. However, it does not do argument validation. If you attempt to get string/array elements beyond the range of the input, ugly things may happen.

    The string-oriented solution uses unpack, and makes the optimization of calling unpack only once. The array-oriented solution has to return arrays, and since there's no way (afaik, in perl 5) to get multiple slices of an array, separately, in a single slicing operation, it can't make a similar optimization: it has to get as many distinct slices as there are "ranges" in the spec. Consequently, that solution is more elegant-looking. We could take the same approach for strings, using substr, and it would look about as elegant, but clearly not as optimized.

    Note that indexing starts at 1 in both cases, in accordance with cut.

    { package Cut; sub from_list { my( $spec ) = @_; map [ $_->[1] < $_->[0] ? reverse @_[ $_->[1] .. $_->[0] ] : @_[ $_->[0] .. $_->[1] ] ], map [ /(.*)\s*-\s*(.*)/ ? ( $1, $2 ) : ( $_, $_ ) ], split /\s*,\s*/, $spec; } sub from_string { my( $spec, $input ) = @_; my @spec = map [ /(.*)\s*-\s*(.*)/ ? ( $1, $2 ) : ( $_, $_ ) ], split /\s*,\s*/, $spec; my $ofs=0; my %reverse; my @pat; for ( 0 .. $#spec ) { my( $lo, $hi ) = @{ $spec[$_] }; if ( $hi < $lo ) { $reverse{$_} = 1; ( $lo, $hi ) = ( $hi, $lo ); } my $move = $lo - $ofs - 1; my $len = $hi - $lo + 1; $ofs = $hi; $pat[$_] = ( $move > 0 ? 'x'.$move : $move < 0 ? 'X'.(-$move) : '' ) . 'a'.$len; } my @result = unpack "@pat", $input; $result[$_] = reverse $result[$_] for keys %reverse; @result } } # some test cases: my @a = Cut::from_string( '1,3-4,6-10,12-8,1,1,1', join '', 'a'..'z' ) +; print "'$_'\n" for @a; my @b = Cut::from_list( '1,3-4,6-10,12-8,1,1,1', 'a'..'z' ); print "> @$_\n" for @b;
    I reckon we are the only monastery ever to have a dungeon stuffed with 16,000 zombies.
Variant of map for special-casing the last item in Cool Uses for Perl
4 direct replies — Read more / Contribute
by jdporter
on Oct 25, 2010 at 10:18

    This is a variant of map which makes it easy to special-case the last item in the list.

    # usage: special_last_map { block } $sentinel_variable, @list_of_value +s; # You should examine the value of the sentinel variable inside your co +de block. # It will be True for the last item in the list; False otherwise. sub special_last_map(&\$@) { my $code = shift; my $is_last_sr = shift; my $n = $#_; map { $$is_last_sr = $_ == $n; local $_ = $_[$_]; &$code } 0 .. $#_ }

    For example, say you're stuffing a list of strings into an html list, and you want to add an attribute to the final <li> element:

    my $is_last; my @list_in_html = special_last_map { my $attr = $is_last ? ' class="last"' : ''; "<li$attr>$_</li>" } $is_last, @list;

    Update: Ok, here's a version which makes checking for first and last items easy; and it uses $a and $b so that you don't have to provide any special variables.

    sub map_with_index(&@) { my $code = shift; my $n = $#_; map { local $a = $_; local $b = $n - $_; local $_ = $_[$_]; &$code } 0 .. $#_ }
    print for map_with_index { my $class = ( $a == 0 ? 'first' : '' ) . ( $b == 0 ? 'last' : '' +); my $attr = $class ? qq( class="$class") : ''; "<li$attr>$_</li>\n" } qw( alpha beta gamma delta );
    What is the sound of Windows? Is it not the sound of a wall upon which people have smashed their heads... all the way through?
Parse a list of path strings into a nested hash in Cool Uses for Perl
2 direct replies — Read more / Contribute
by jdporter
on Sep 03, 2010 at 16:05

    This has been tried (and done) many times before; it's almost a coming-of-age ritual. Heck, I've even done it myself before, long ago.

    This is the way I feel like doing it today. What I don't like about it is that its performance is something like O(nm), where m is average number of parts in each path.

    I'm sure there are better (for most definitions of "better") ways to do it; for example, tye suggested his Data::Diver module.

    sub paths2tree { my $hr = {}; @{$hr}{@_} = map { {} } @_; my $n_repls; do { $n_repls=0; for ( sort { length($b) <=> length($a) } keys %$hr ) { if ( /(.*)\\(.*)/ ) { $hr->{$1}{$2} = delete $hr->{$_}; $n_repls++; } } } while ( $n_repls ); $hr }

    NB - This is hardcoded for the CP/M-style backslash path separator. You could generalize it if you want to. ;-)

    Update: Upon reflection, I'm not sure you can get away from the O(nm) performance. At best, you can make the inner loop more efficient, e.g. by eliminating an explicit for loop and using a //g regex instead. But that doesn't change the "big O".

    What is the sound of Windows? Is it not the sound of a wall upon which people have smashed their heads... all the way through?
CGI::AppEasy - a quick way to give your perl program a web-based user interface in Cool Uses for Perl
5 direct replies — Read more / Contribute
by jdporter
on Apr 13, 2010 at 14:42

    This module makes it a snap to give your perl program a web-based user interface. It adds a little wrapper around the essential interfaces of HTTP::Daemon (which, thankfully, is a core module).

    This module makes certain assumptions and imposes certain constraints on how your program will interpret http requests, which in turn constrains the space of valid URLs which can be requested of your program. However, what is allowed should be sufficient for most simple needs. If you need more sophisticated web request handling, there are plenty of options, ranging all the way up to Apache+mod_perl or any number of content management systems.

    The essence is this: each (valid) path (part of the URL) is mapped to a function in your code. The query part of the URL is parsed and is passed to the function as hash-like "named" arguments. For example, to call the sub Update whenever the URL path part is /update, configure your CGI::AppEasy object like so:

    '/update' => \&Update,
    The sub should be defined like so:
    sub Update { my $appeasy = shift; # your CGI::AppEasy object .... return qq(<h1>update successful</h1>) # or whatever }
    The html blob returned by such handler functions is sent to the browser as is.

    If you need to set the http status code to something other than 200, you can do

    $appeasy->response->code( 404 ); # or whatever
    If you don't do that, code 200 (Success) will be returned.

    $appeasy->response is the HTTP::Response object which will be sent to the client. You have full access to that object, if, for example, you want to set cookies, or change the returned content type to something other than text/html, or whatever.

    You can also associate a command with a "static" blob of text, rather than a function:

    '/help' => \$help_text,

    You should probably have a command handler for the "default" case:

    '/' => \$default_page,

    Note that partial path matching is done, so that if you have defined a handler for path /foo and you request the path /foo/bar, that will get handled by your /foo handler. The full path of the request is available via the method path. This makes it possible to define just one handler, for path /, and do your own path inspection/handling.

    The default port is 8080 but you can override this via the named parameter LocalPort when you construct or call serve.

    $appeasy->cgi is a CGI object containing virtually all of the info you would need to handle the request. I've tried to initialize it with as much info from the request as I can, but I don't guarantee that it is as complete as a CGI object would be if running under a "real" http server (such as Apache).

    See my reply below for a complete working example application. (NOTE: not sync'd to the current version of the module.)

    What is the sound of Windows? Is it not the sound of a wall upon which people have smashed their heads... all the way through?
Fermions and FermionicSpaces in Cool Uses for Perl
3 direct replies — Read more / Contribute
by jdporter
on Jan 17, 2010 at 21:57

    The thing that makes this interesting, and different from physical reality (afaik), is that a fermion can live in more than one space. If it does, it has the same state(s) in all of the spaces it lives in.

    Imagine, if you will, two fermionic spaces, and three fermions. Each space contains two fermions, and one of the three fermions lives in both spaces. Label the fermions A, B, and C:

     | A  B |
    so that B is in both spaces.
    The fermions have two possible states: 0 and 1. Initially, each fermion is in a superposition of states (0,1).
    Now suppose that A collapses to state 0. This forces* B to collapse to state 1. This in turn forces* C to collapse to state 0.

    * due to the Pauli exclusion principle, which Fermions obey.

    Here is code which implements the above example:

    use FermionicSpaces; use strict; use warnings; my $fs = new FermionicSpaces states => [ 0, 1 ]; my $s1 = $fs->new_space; my $s2 = $fs->new_space; my $A = $fs->new_fermion( id => 'A' ); my $B = $fs->new_fermion( id => 'B' ); my $C = $fs->new_fermion( id => 'C' ); $fs->add_fermion_to_space( $A, $s1 ); $fs->add_fermion_to_space( $B, $s1 ); $fs->add_fermion_to_space( $B, $s2 ); $fs->add_fermion_to_space( $C, $s2 ); print "Before:\n", $fs->as_string; $A->disallow_states(1); $fs->do_all_possible_exclusions; print "After:\n", $fs->as_string;
    What is the sound of Windows? Is it not the sound of a wall upon which people have smashed their heads... all the way through?
Tie::Scalar to load multiple Data::Dumper generated assignments in Cool Uses for Perl
No replies — Read more | Post response
by jdporter
on May 21, 2009 at 15:03

    Ok, a lot of times I just do what I feel is the quickest possible thing — the thing I can do without hardly thinking about it. I am Lazy, after all. ;-)

    When I'm developing and debugging, I need to examine data structures, and for this, I usually reach for Data::Dumper. Sometimes my program will dump out many structures in one run.

    By default, Data::Dumper encodes each dumped structure in an eval-able assignment statement, the receieving variable being named $VAR1. If I'm redirecting this output to a file, I could have a file containing numerous assignments to the same variable. The challenge: to load the file as perl code, in such a way that all the data structures are loaded and available. How can this be done if each statement overwrites the same variable?

    Rather than munge the generated file, or figure out how to tweak Data::Dumper to do exactly what I need, I did something I knew would work without even having to think about it. I am, after all, Lazy.

    I tied $VAR1 so that assignment to it actually pushes the value onto an array.

    { package Tie::Scalar::PushArray; sub TIESCALAR { my( $pkg, $ar ) = @_; bless { arrayref => $ar || [] }, $pkg } sub STORE { my $self = shift; push @{ $self->{'arrayref'} }, @_; } sub FETCH { my $self = shift; $self->{'arrayref'} } } tie our $VAR1, 'Tie::Scalar::PushArray'; do "data-dumper.out"; # load and eval. $_="VAR1=$VAR1\n"; # NB: It is necessary to do something like this # before trying to access $VAR1 as an arrayref! print "Loaded ".@$VAR1." elements\n";
    Between the mind which plans and the hands which build, there must be a mediator... and this mediator must be the heart.
Implementing Theta Join (select/where) using iterators in Cool Uses for Perl
No replies — Read more | Post response
by jdporter
on Jul 21, 2008 at 17:03

    I present here a technique for performing a Θ join on two or more data sets.
    This does in perl what SELECT/WHERE does in SQL (approximately).

    The input data sets and the result set are presented via iterators. The implementation below leverages the techniques and classes I posted in Using Nested Iterators to find a Cross Product and A Filtering Iterator.

    # sample data. I use arrays for illustrative purposes, # but data could come from anywhere. my @author = ( [ 'Alonzo', 'Church', ], [ 'Stephen', 'Kleene', ], [ 'Wilhelm', 'Ackermann', ], [ 'Willard', 'Quine', ], ); my @author_book = ( [ 'Alonzo', '0691029067', ], [ 'Stephen', '0486425339', ], [ 'Wilhelm', '0821820249', ], [ 'Wilhelm', 'B000O5Q8QG', ], [ 'Willard', '0674554515', ], [ 'Willard', '0674802071', ], ); my @book_title = ( [ '0674802071', 'Set Theory and Its Logic', ], [ '0674554515', 'Mathematical Logic', ], [ 'B000O5Q8QG', 'Solvable Cases of the Decision Problem', ], [ '0821820249', 'Principles of Mathematical Logic', ], [ '0486425339', 'Mathematical Logic', ], [ '0691029067', 'Introduction to Mathematical Logic', ], ); my $join_authors_books = # a filter iterator for implementing our join condition: Iterator::Filter->new( # iterator for walking the cross product: Iterator::Product->new( # iterators for each of the above arrays: Iterator::Array->new( \@author ), Iterator::Array->new( \@author_book ), Iterator::Array->new( \@book_title ), ), # our condition: # where author.name = author_book.name # and author_book.isbn = book_title.isbn sub{ my($author,$author_book,$book_title) = @_; # each is an arrayref - a row from the corresponding "table" $author->[0] eq $author_book->[0] && $author_book->[1] eq $book_title->[0] } ); until ( $join_authors_books->is_exhausted ) { my($author,$author_book,$book_title) = $join_authors_books->value; local($,,$\) = ("\t","\n"); # the $author_book array doesn't contain any info not present in t +he other two print @$author, @$book_title; }
    Between the mind which plans and the hands which build, there must be a mediator... and this mediator must be the heart.
A Filtering Iterator in Cool Uses for Perl
1 direct reply — Read more / Contribute
by jdporter
on Jul 21, 2008 at 12:37

    I present here an iterator which applies filtering to some other iterator. You give it an iterator and a condition; it returns an iterator which produces the same sequence of values as the iterator you gave would, except those values which don't meet the condition are not returned, they are skipped.

    This iterator conforms to the interface of Iterator, except that the value method can return lists of values, not just single scalars. Besides new, it implements reset, value, and is_exhausted.

    The iterator you pass in should similarly implement the interface of Iterator. This "inner iterator" must implement methods reset, value, and is_exhausted. Again, its value method can return multiple values or a single value.

    The condition is defined as a subroutine, passed by reference. It will receive in @_ the value(s) returned by each call to the inner iterator's value method. It should return a boolean value. This will be used to determine whether that value will be returned by the outer iterator (the one created by this class).

    Let's look at the code:

    { package Iterator::Filter; sub new { my $self = bless {}, shift; $self->{'iterator'} = shift; $self->{'condition'} = shift; $self->reset; $self } sub reset { my $self = shift; $self->{'iterator'}->reset; $self->_advance; } # post-condition: either # a. iterator is not at end, and value is set; or # b. iterator is at end, and value is not set. sub _advance { my $self = shift; my @value; delete $self->{'value'}; while ( !$self->{'iterator'}->is_exhausted ) { @value = $self->{'iterator'}->value; if ( $self->{'condition'}->( @value ) ) { $self->{'value'} = \@value; last; } } } sub value { my $self = shift; $self->is_exhausted and die "past end"; my $value = $self->{'value'}; $self->_advance; @$value } sub is_exhausted { my $self = shift; !exists $self->{'value'} } }

    Here's a sample application. The inner iterator returns the values in a given array, containing the integers 1 to 10. The condition returns true for those numbers which are odd. (Note that the inner iterator is created using the Iterator::Array class presented in Using Nested Iterators to find a Cross Product.)

    my $fi = new Iterator::Filter Iterator::Array->new( [ 1 .. 10 ] ), # inner iterator sub { $_[0] % 2 }; # condition print $fi->value, "\n" until $fi->is_exhausted ;
    Between the mind which plans and the hands which build, there must be a mediator... and this mediator must be the heart.
Using Nested Iterators to find a Cross Product in Cool Uses for Perl
No replies — Read more | Post response
by jdporter
on Jul 18, 2008 at 17:25

    The code below demonstrates a technique for nesting iterators (specifically, external iterators) by way of a trivial application, iterating over the cross product of a list of arrays.

    I am aware that there is a module on cpan for iteratively generating the cross product of a set of arrays: Set-CrossProduct. My purpose here is to illustrate the principle transparently, in code. Also, Set-CrossProduct only operates on actual arrays*, whereas my class, below, operates on black-box iterators. tye's excellent Algorithm::Loops::NestedLoops has a similar limitation. It can give you an iterator for iterating over the cross product, but it only accepts arrays as input.

    In conclusion, I reiterate that my purpose here is to demonstrate how one iterator may "nest" other iterators, using a canonical pedagogical example. The essense of an iterator is to return one thing — the "next" thing — on each request, and so must remember where it left off the last time it was called. In this case, since the real work of iteration is being done by sub-iterators, the iterator only needs to manage how it's calling the subiterators and composing the results from each.

    Further reading: How To: Make An Iterator; Re: Variation on the "Higher Order Perl" Iterator Pattern.

    Between the mind which plans and the hands which build, there must be a mediator... and this mediator must be the heart.
fft japh in Obfuscated code
1 direct reply — Read more / Contribute
by jdporter
on Apr 17, 2008 at 11:53

    Based on technique discussed in encode a string into a complicated-looking trigonometric function

    print chr(91.540 + 0.765*cos(0.251*$_) + 3.886*sin(0.251*$_) - 1.470*cos(0.503*$_) - 7.599*sin(0.503*$_) + 4.480*cos(0.754*$_) - 1.094*sin(0.754*$_) - 11.495*cos(1.005*$_) + 22.147*sin(1.005*$_) + 1.792*cos(1.257*$_) + 8.512*sin(1.257*$_) - 20.389*cos(1.508*$_) - 1.167*sin(1.508*$_) - 1.011*cos(1.759*$_) + 2.549*sin(1.759*$_) + 2.712*cos(2.011*$_) + 3.110*sin(2.011*$_) + 6.179*cos(2.262*$_) - 2.177*sin(2.262*$_) - 2.232*cos(2.513*$_) + 16.511*sin(2.513*$_) + 5.236*cos(2.765*$_) + 1.260*sin(2.765*$_) - 1.607*cos(3.016*$_) + 4.017*sin(3.016*$_) )for 0..24;

    Update: Small change, props to ambrus.

    A word spoken in Mind will reach its own level, in the objective world, by its own weight