Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number

The Monastery Gates

( #131=superdoc: print w/ replies, xml ) Need Help??

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
FOSDEM 2015 - any news on the party?
No replies — Read more | Post response
by polettix
on Jun 29, 2015 at 17:52

    since when it happened, I'm regularly checking the FOSDEM website for the video of the talk from Larry Wall "get ready to party". It's a bit depressing that so far nothing appeared, and that of all the "main tracks" the one on languages - where the talk should appear - is still empty. I'm using this link:

    Does anyone know if there is some not-so-evident reason that is preventing the release of those videos? Is it just that I need to have some little more patience?

    Thanks, Flavio.

    perl -ple'$_=reverse' <<<ti.xittelop@oivalf

    Io ho capito... ma tu che hai detto?
Installing Module::Info 0.35 for Strawberry Perl 5.22.0
2 direct replies — Read more / Contribute
by Athanasius
on Jun 28, 2015 at 11:50

    Background. I’ve started using Strawberry Perl 5.22.0, and I’m trying to install tobyink’s useful P5U module. It has various dependencies, one of which fails to install: Module::Info, which fails 2/7 tests, 11/121 subtests. From the CPAN Testers Matrix it appears that Module::Info has failed almost universally across all platforms since Perl version 5.21.2. But are these failures serious or trivial? I decided to investigate.

    Many of the failures are traceable to the Subroutine B::OP::parent redefined warning which appears to be a known problem. The tests fail in two test modules:

    • t/Module-Info.t (10/59)
    • t/n1_modules.t (1/3)

    It is the single test failure in the second of these modules that is currently puzzling me.

    The problem. The subtest which fails in t/n1_modules.t is this:

    is_deeply( [ sort keys %mods ], [ sort qw(Cwd strict Carp) ], "Got the correct modules" );

    It fails as follows:

    # Failed test (t\n1_modules_required.t at line 17) # Structures begin differing at: # $got->[2] = 'Win32' # $expected->[2] = 'strict' # Looks like you failed 1 tests of 3. t\n1_modules_required.t .. Dubious, test returned 1 (wstat 256, 0x100) Failed 1/3 subtests

    This failing subtest is supposed to verify that the 3 listed modules are used or required by the test module t/lib/ Here are the full contents of that module:

    package Bar; use Cwd; use Cwd 1; use Cwd 1.00102; use Cwd 1.1.2; BEGIN { cwd(); } BEGIN { $x = 1; $x = 2; require strict; } sub my_croak { require Carp; Carp::croak(cwd, @_); } 1;

    It has 24 lines. I have used a hex editor to confirm that there is nothing extra “lurking” in the file — WYSIWYG. Note that there is no mention of the Win32 module in

    The labyrinth. The route taken by the chain of subroutine calls from the failing test back to the source of the discrepency is a tortuous one (for ease of reading I have replaced the full paths with ellipses):

    1. The failing subtest on line 14 of t/n1_modules_required.t compares a list of modules found against a list of expected modules. Since these are the modules used or required by t/lib/, the expected modules are (naturally) Cwd, strict, and Carp. The modules are found via the following calls:

      my $bar = Module::Info->new_from_module( 'Bar' ); ... my %mods = $bar->modules_required;
    2. Module::Info->new_from_module calls Module::Info->_find_all_installed, which returns this object:

      bless({ dir => "...\\t\\lib", file => "...\\t\\lib\\", name => "Bar", safe => 0, use_version => 0, }, "Module::Info")
    3. The call to Module::Info->modules_required gets a list of modules via the following call:

      my @mods = $self->_call_B('modules_used');
    4. _call_B in turn calls my($status, @out) = $self->_call_perl($command); with $command set to:

      "-MO=Module::Info,modules_used" "...\t\lib\"
    5. _call_perl calls @out = `$command 2>&1`; with $command set to:

      ...\perl\bin\perl.exe "-MO=Module::Info,modules_used" "...\t\lib\Bar. +pm"

    The anomalies. Now, here’s where things get weird. First, we seem to have entered an infinite regression: modules_required calls _call_B, which calls _call_perl, which (apparently) calls modules_used. But modules_used calls modules_required, so we seem to be back where we started. But there is no infinite regression, so that can’t be what’s happening. Ok, so what does the call to:

    ...\perl\bin\perl.exe "-MO=Module::Info,modules_used" "...\t\lib\Bar. +pm"

    actually do?

    Second, that last call returns the following data:

    Subroutine B::OP::parent redefined at ...\blib\lib/B/ line 21 +7. , use Cwd () at "...\t\lib\" line 3 , use Cwd (1) at "...\t\lib\" line 4 , use Cwd (1.00102) at "...\t\lib\" line 5 , use Cwd (v1.1.2) at "...\t\lib\" line 6 , use Win32 (0.27) at "...\t\lib\" line 624 , require bare at line 15 , require bare at line 19 , ...\t\lib\ syntax OK

    Note that the Win32 module is reported as being used on line 624 of file Not only does that file contain no mention of Win32; but it’s only 24 lines long! How does the call find an unmentioned module on a non-existent line of code?

    I previously installed the same version (0.35) of Module::Info under Strawberry Perl 5.20.2, with no errors.

    The questions. Can anyone shed any light on any of this? Suggest a way to carry the researches forward? Explain what happened between 5.20.2 and 5.22.0 to account for this bizarre behaviour? Assure me that force installing Module::Info will be safe?

    Anyway, thanks for looking, :-)

    Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

anchor ^ and \G
5 direct replies — Read more / Contribute
by Anonymous Monk
on Jun 27, 2015 at 19:14

    Is it possible to use both ^ and \G ?

    my $string = " a 1 # "; my $i = 0; while () { if ( $string =~ /^\G\s+/gc ) { print "whitespace\n"; } elsif ( $string =~ /^\G[0-9]+/gc ) { print "integer\n"; } elsif ( $string =~ /^\G\w+/gc ) { print "word\n"; } else { print "done\n"; last; } }
    desired output: whitespace word whitespace integer whitespace done
Avoiding SQL double jeopardy
3 direct replies — Read more / Contribute
by GrandFather
on Jun 26, 2015 at 21:57

    As part of a scheduling project I need to retrieve "active sessions" for selected people. For each session a person may be the teacher or learner. I have code (see getActiveSessions) that retrieves the data I want from the Sessions table in a SQLite database. However the duplication if the id list to be matched smells somewhat to me. Can you come up with a tidy alternative that avoids duplicating the id list?

    A test script that reflects the current code is given below:

    use strict; use warnings; use DBI; my $dbh = DBI->connect('dbi:SQLite:dbname=xr.SQLite'); $dbh->do(<<SQL); CREATE TABLE Sessions ( SessId INTEGER PRIMARY KEY AUTOINCREMENT, TeacherId INTEGER, LearnerId INTEGER, DoneDate TEXT, Topic TEXT ) SQL my $self = bless {dbh => $dbh}; $self->addSession(1, 2, 'Perl is fun', '2015-06-27'); $self->addSession(3, 4, 'SQL is fun', '2015-06-27'); $self->addSession(3, 5, 'SQL for fun and profit', '2015-06-20'); $self->addSession(4, 1, 'PerlMonks is great', '2015-06-20'); $self->addSession(2, 6, 'PerlMonks is great', '2015-06-20'); my $active = $self->getActiveSessions(1, 2); print "$_->{TeacherId}, $_->{LearnerId}: '$_->{Topic}'\n" for values %$active; sub addSession { my ($self, $teacher, $learner, $topic) = @_; $self->{dbh}->do(<<SQL, {}, $teacher, $learner, $topic); INSERT INTO Sessions (TeacherId, LearnerId, Topic, DoneDate) VALUES (?, ?, ?, '') SQL } sub getActiveSessions { my ($self, @ids) = @_; my $idPlaces = (join ', ', ('?') x @ids) || ''; $idPlaces = <<SQL if $idPlaces; AND (TeacherId IN ($idPlaces) OR LearnerId IN ($idPlaces)) SQL return $self->{dbh}->selectall_hashref(<<SQL, 'SessId', {}, @ids, +@ids); SELECT SessId, TeacherId, LearnerId, Topic FROM Sessions WHERE DoneDate == ''$idPlaces SQL }


    4, 1: 'PerlMonks is great' 1, 2: 'Perl is fun' 2, 6: 'PerlMonks is great'
    Perl is the programming world's equivalent of English
Is Text::FIGlet broken?
1 direct reply — Read more / Contribute
by Anonymous Monk
on Jun 25, 2015 at 13:24
    I have tried this on several environments and I keep getting the same mangled results:
    my $font = Text::FIGlet->new(-f=>"block", -d=>"/usr/share/figlet"); print $font->figify(-A=>"Hi");
    _| _| _| _| _| _|_|_|_| _| _| _| _| +_| _| _|


    figlet -f block Hi _| _| _| _| _| _|_|_|_| _| _| _| _| _| _| _|

    Any ideas? I am stumped.
Template Toolkit - Output Template Name / Filepath as HTML Comment
4 direct replies — Read more / Contribute
by cjoy
on Jun 25, 2015 at 10:28

    Is there a way to have Template Toolkit output a HTML comment containing the file path when each template is called, without specifically declaring it in every single file / block?

    The idea is to more easily track down what template a piece of markup in the browser came from (usage context is Bugzilla 5.0).

    A quick search in both, the TT documentation and the Badger book yielded no results.

Redirecting/Restoring of Memory Files
4 direct replies — Read more / Contribute
on Jun 25, 2015 at 07:43

    Is there a better way to do this? Am I using the correct idiom? Is this a bug? My Perl version is 5.18 (Mac OS Yosemite system perl)

    I recently noticed that attempts to dup/restore a file handle pointing to string turns that file handle into a black hole. Writes (e.g.print) to file handle don't seem to appear in the output when the file handle is restored after dupping. New input isn't appended to the string, nor does it replace the beginning of the re-opened memory file/string.

    The black hole goes away if I reopen using substr($s,length($s)) where $s is the original variable used to create the memory file handle.

    Trying to reopen in append mode also results in a black hole on my macbook

    Below (hidden with readmore) is a script demonstrating the problem.

    Edit1: clarified instructions for running script, more details about Perl version. Thank-you Disciplus for suggestions.

    Edit 2: revised script so that it just runs without needing to uncomment anything and also prints out your perl version - once again thank-you Disciplus, this time for the idea of using config.

    Edit 3: revised script to include option to reopen file in append mode - which also doesn't work on Perl 5.18 on Darwin

Dynamic table names and DBIx::Class
2 direct replies — Read more / Contribute
by einhverfr
on Jun 25, 2015 at 05:05

    This is not a normal situation but I am working with a partitioned table and would like to route selects against the parent table to the partitions directly (in order to avoid the db planner requiring access to the other tables for constraint exclusion reasons.

    Ideally primary key would have a field in a multi-column pkey, something like "partion_id" and the table name would be something like "mytable_" . $self->partition_id.

    What is the best way to accomplish this?

    Edit: Selecting on the main table works from an application perspective but it has unpleasant effects on database administration tasks (ones which lock any underlying tables block *all* queries on the parent table) and one can't just use a view because the view doesn't get to decide without doing exactly what the current query is doing (a union through all with constraint exclusion). Subclassing isn't an option because this is a component of a complex system and subclassing for every partition will get ridiculous quickly. So I am looking to see if there is a way I can tie the table to the object instead of the package.

Soft Array Refs
2 direct replies — Read more / Contribute
by smknjoe
on Jun 23, 2015 at 18:22
    Hello all,

    I've looked all over SoPW for some information on how to implement array soft references, but no luck. I'm having trouble making my script more flexible with array naming.

    As you can see, I'm defining the array names at the top (I know what they will be called when they are parsed in), but when it comes to populating them, I'd like the flexibility. I'm using "no strict 'refs';" and eval. I'd rather use "use strict" if possible and write clean code, but then it turns into a very rigid set of 'if' statements that requires much more editing.

    Perhaps someone can point me to a better solution...

    Thanks, smknjoe

    #!/usr/bin/perl #use strict; no strict 'refs'; use warnings; my @table_min_1; my @table_min_2; my @table_max_1; my @table_max_2; my @fields; my $array_name; my $item; while (my $lines = <DATA>) { chomp($lines); if ($lines =~ /Array\s+(\w+)\s+(\d+)/) { # array ref $array_name = "\$table_" . $1 . "_" . $2; } else { @fields = split(/\s+/,$lines); my $value = $fields[1]; #print "debug: $array_name \n"; eval "push @{$array_name}, $value"; } } foreach $item (@table_min_1) { print "$item\n"; } foreach $item (@table_min_2) { print "$item\n"; } foreach $item (@table_max_1) { print "$item\n"; } foreach $item (@table_max_2) { print "$item\n"; } __DATA__ Array max 1 useless_text_field a useless_text_field b useless_text_field c Array max 2 useless_text_field 1 useless_text_field 2 useless_text_field 3 Array min 1 useless_text_field d useless_text_field e useless_text_field f Array min 2 useless_text_field 4 useless_text_field 5 useless_text_field 6
    The code should simply dump out:
    a b c 1 2 3 d e f 4 5 6
File::LibMagic's tests fail on OpenBSD
2 direct replies — Read more / Contribute
by choroba
on Jun 23, 2015 at 17:21
    My June assignment for The CPAN Pull Request Challenge is File::LibMagic. The module fails exclusively on OpenBSD, and the test suite never passes on it. The problem seems to be the same every time:
    # Failed test 'got expected info for symlink to PDF' # at t/constructor-params.t line 27. # Structures begin differing at: # $got->{mime_with_encoding} = 'application/pdf; charset=unkn +own' # $expected->{mime_with_encoding} = 'application/pdf; charset=bina +ry'

    Is it just a difference between libmagic on OpenBSD and other systems? If so, could the test be fixed with

    my $encoding = 'openbsd' eq $^O ? 'unknown' : 'binary'; is_deeply( $info, { description => 'PDF document, version 1.4', mime_type => 'application/pdf', encoding => $encoding, mime_with_encoding => 'application/pdf; charset=' . $encod +ing, }, 'got expected info for symlink to PDF' );

    Or is the encoding of a PDF something that could break dependent code?

    Bonus points

    Some of the tests also end prematurely

    error calling magic_file: zlib: (null) at /home/cpan/pit/bare/conf/per +l-5.12.4/.cpanplus/5.12.4/build/File-LibMagic-1.12/blib/lib/File/LibM line 107. # Tests were run but no plan was declared and done_testing() was not s +een. # Looks like your test exited with 79 just after 2.

    Again, does it mean that zlib on OpenBSD isn't installed by default, unlike other OSes? How could one solve the problem?

    Answers from OpenBSD users most welcome.

    لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Question about flock and printing to file
8 direct replies — Read more / Contribute
by deruytja
on Jun 23, 2015 at 11:10

    Hello Monks, maybe someone can explain this behaviour to me: I've already "played" a bit with the flock system in Perl, and noticed, if I print an array directly everything works fine, if I print only some values it doesn't work (Lines get corrupted / wrongly printed):

    flock($fh, LOCK_EX) or die "cannnot lock file - $!\n"; print $fh @out; #print $fh $out[0]; #Date #print $fh $out[1]; #Site #print $fh $out[2]; #CTR #print $fh $out[3]; #IP #print $fh $out[4]; #Temperature flock($fh, LOCK_UN) or die "cannnot unlock file - $!\n";

    why does it behave like this? Or is flock only for the next print argument?

    Thanks in advance!
How to split file for threading?
5 direct replies — Read more / Contribute
by diyaz
on Jun 23, 2015 at 10:07
    Hi Monks, I have to filter >20GB files, just pulling any line that has a user specified keyword. It processes tab delimited file and searches through each field for keyword. I have the single threaded version here (please excuse my novice coding/commenting):
    use strict; use warnings; use Data::Dumper; #declarations my @rawfile; my $filter_count=0; #input open(INFILE, "<$ARGV[0]") || die "cannot open file:$!"; #### #filter file #------------------ # parse entire file my $header = <INFILE>; #grabbing header chomp $header; my @headerArray = split("\t", $header); my $sizeheader=@headerArray; for my $line (<INFILE>) { chomp $line; my @splitline = split("\t", $line); #my $poskey = $splitline[0] . ":" . $splitline[1]; for (@splitline){ if (/^$ARGV[1]/){ $filter_count++; push(@rawfile,$line); } } } close INFILE; print "Completed filtering $ARGV[0]\n"; print "Found $filter_count elements\n"; my $outfilename = substr($ARGV[0],0,length($ARGV[0])-4)."_filter.txt"; print "Filtering to output file: $outfilename\n"; #### #output file #------------------ open(OUTFILE, ">$outfilename") || die "cannot open file to write: $!"; print OUTFILE "$header\n"; for (@rawfile) { print OUTFILE "$_\n"; } close OUTFILE;
    I hope this will be a good example to learn threading from. Thanks!
New Cool Uses for Perl
Syntax-highlight Non-Perl Code for HTML
1 direct reply — Read more / Contribute
by kcott
on Jun 29, 2015 at 01:19

    G'day All,

    I use a scripting language, called NWScript, for some CRPG development that I do from time to time.

    I wrote the following Perl script to syntax-highlight NWScript code for HTML rendering:

    #!/usr/bin/env perl use 5.014; use warnings; { my %entity_for = qw{& &amp; < &lt; > &gt;}; sub chars_to_ents { $_[0] =~ s/([&<>])/$entity_for{$1}/gr } } my @plain_captures = qw{white_space remainder}; my @highlight_captures = qw{operator variable function constant statem +ent datatype comment string integer float prag +ma}; my $re = qr{ (?> (?<white_space> \s+ ) | (?<comment> (?> \/\* (?: . (?! \*\/ ) )*+ (?: . (?= \*\/ ) )?+ \*\/ | \/\/ [^\n]* $ ) ) | (?<pragma> (?> [#]include \s+ " \w+ " \s* $ | [#]define \s+ \w+ \s+ \w+ \s* $ ) ) | (?<string> " (?: [^"\\]++ | \\. )*+ " ) | (?<float> \b \d+ \. \d+ f? \b ) | (?<integer> \b \d+ \b ) | (?<constant> \b [A-Z0-9_]+ \b ) | (?<datatype> \b (?> action | const | effect | event | float | int | itemproperty | location | object | string | struct \s+ \w+ | talent | vector | void ) \b ) | (?<statement> \b (?> break | continue | do | for | if | else | return | switch | case | default | while ) \b ) | (?<function> \b [A-Za-z_] \w* (?= \s*\( ) ) | (?<variable> \b [A-Za-z_] \w* \b ) | (?<operator> (?> \>\>\>\= | \>\>\> | \>\>\= | \<\<\= | \>\> | \<\< | \+ +\+ | \-\- | \&\= | \|\= | \^\= | \*\= | \/\= | \%\= | \+\= | \-\ += | \=\= | \!\= | \<\= | \>\= | \&\& | \|\| | \< | \> | \! | \& | \| | \^ | \~ | \* | \/ | \% | \+ + | \- | \= | \? | \: | \; | \. | \{ | \} | \( | \) | \, | \@ ) ) | (?<remainder> .*? ) ) }msx; my $init_code = do { local $/; <> }; say '<pre class="syntax-highlight">'; MATCH: while ($init_code =~ /$re/g) { for my $plain_capture (@plain_captures) { if (exists $+{$plain_capture}) { print $+{$plain_capture}; next MATCH; } } for my $highlight_capture (@highlight_captures) { if (exists $+{$highlight_capture}) { print '<span class="', $highlight_capture, '">', chars_to_ents($+{$highlight_capture}), '</span>'; next MATCH; } } } say '</pre>'; exit;

    NWScript uses a C-like syntax. I'm aware that a few monks use NWScript; however, I'd guess most don't and have probably never heard of it. So, purely to provide an example that's looks a little more familiar to most, here's a slightly fudged (just the #include pragma) hello.c:

    /* hello.c */ #include "stdio" main() { printf("hello, world\n"); }

    And here's the output after running that through my script:

    <pre class="syntax-highlight"> <span class="comment">/* hello.c */</span> <span class="pragma">#include "stdio" </span> <span class="function">main</span><span class="operator">(</span><span + class="operator">)</span> <span class="operator">{</span> <span class="function">printf</span><span class="operator">(</span +><span class="string">"hello, world\n"</span><span class="operator">) +</span><span class="operator">;</span> <span class="operator">}</span> </pre>

    For anyone wishing to use this script, here's the CSS I use (in the Spoiler):

    -- Ken

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (11)
As of 2015-06-30 05:40 GMT
Find Nodes?
    Voting Booth?

    What kind of chocolate gives you the most pleasure?

    Results (777 votes), past polls