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

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
How to concatenate utf8 safely?
1 direct reply — Read more / Contribute
by gregor42
on Oct 21, 2016 at 10:22

    I am humbled and seeking help.

    This concerns data containing names so getting it Right is important.

    It is likely that I am fundamentally missing something when it comes to safely concatenating strings.

    A hand-rolled point solution sometimes works as intended and others times results in the dreaded:

    Wide character in syswrite

    I assume that the problem is my code and not the data coming in since one can usually depend on people to get their own names right.. But then i18n characters are tricksy, like Hobbits...

    sub jibe { my($s,$t) = @_; my $r = join('', (is_utf8($s)?$s:decode('utf8',$s)), (is_utf8($t)?$t +:decode('utf8',$t))); return $r; }

    To give it context, let's say that we are creating common name from given name plus surname: (Anglo-centric, I know...)

    my $cn = jibe(jibe($givenname," "),$sn);

    Thank you in advance for any nudges in the right direction that anyone might provide.

    Wait! This isn't a Parachute, this is a Backpack!
Get latest file created or modified & matching part of file name :
1 direct reply — Read more / Contribute
by rahulme81
on Oct 21, 2016 at 09:49

    Hello Monks

    I have a directory with a bunch of files. I'm trying to find the latest file created or modified by time in a directory and using the following pattern

    opendir(my $DIRH, $DIR) or die "Error opening $DIR: $!"; my @files = map { [ stat "$DIR/$_", $_ ] } grep( ! /^\.\.?$/, readdir( $DIRH ) ); #This find me +all files not have dot in directory #How this grep can be accommodate for my regular expre +ssion ????? closedir($DIRH); sub latestFile { $b->[0]->ctime <=> $a->[0]->ctime } my @latest_files = sort latestFile @files; my @latest = @{$latest_files[0]}; my $name = pop(@latest); print "Latest file created fro $name\n";

    This is giving the latest file in the directory, but not the file which i need as per my regular expression.

    I need to parse the file and do something, which eventually I am able to achieve

    Facing difficulty with file name pattern match and get the latest file

Module for form validation and resubmission
1 direct reply — Read more / Contribute
by Dallaylaen
on Oct 21, 2016 at 07:33

    Hello, dear esteemed monks!

    tl;dr: I'm thinking of a module that (1) compiles a set of validation rules once and (2) for each hashref given to it later, returns another object containing valid data, errors, AND initial input for processing and/or resubmission.

    Is there such a module already? If not, should I roll my own? If yes, does the API described below seem sensible?

    Now the whole story. Some time ago there was a discussion here at Perlmonks pointing out that it would be nice to make create button act as preview if post content was edited. Can't find proofs now, but the idea impressed me much.

    Recently I started looking for a form validator. My initial idea was to build a permanent validator object once and keep throwing inputs at it later. And I found a module with almost the interface I imagined - Validator::LIVR.

    However, after trying to actually implement form validation & resubmission, I found myself juggling 3 hashrefs (valid data, errors, raw user input for reentry). This was not very convenient, so I decided to pack them into one object, adding is_valid() method on top. And I found a module on CPAN with almost the interface I imagined (but without the "compile once" part) - Data::CGIForm.

    So I crossed these two and got roughly the following API:

    # initialization # the hash describes regexps, requiredness, and other checks # per input key my $validator = My::Class->new ( { ... } ); # later when processing request my $form = $validator->validate( { get => "params" } ); if ($form->is_valid) { do_something( $form->data ); redirect( "/somewhere" ); } else { show_form_again( display_errors => $form->error, input_defaults => + $form->raw ); };

    Also error content (and thus is_valid return value) can be modified, just like in Data::CGIForm:

    if (!load_user($form->data->{user})) { $form->error( user => "No such user in database" ); };

    Unfortunately, the Data::CGIForm has a fatal flaw: error() without arguments acts like my is_valid(), while separate errors() method returns all errors as hash. Error/errors is prone to typoes in my opinion, but maybe I should shut up my ego and stay compatible to an existing API instead?

    Thank you

How relevant is the order of 'use's ?
2 direct replies — Read more / Contribute
by Krambambuli
on Oct 20, 2016 at 07:47
    Dear Monks,

    I have two simple modules:
    package Demo1; use base qw/Exporter/; $SUCCESS = 1; BEGIN { use Exporter(); @ISA = qw(Exporter); @EXPORT = qw( $SUCCESS ) } 1;
    package Demo2; sub import { ${[caller]->[0].'::'}{$_} = ${__PACKAGE__."::"}{$_} foreach grep { not /^(ISA|isa|BEGIN|import|Dumper)$/ } keys %{__PACKAGE__."::"}; } use constant { SUCCESS => 0, }; 1;
    and a minimalistic test program, that is
    #!/usr/bin/perl use strict; use warnings; use Demo1; use Demo2; print "SUCCESS: ", SUCCESS, "\n"; print "\$SUCCESS: $SUCCESS\n"; exit;
    If I run the program as shown, I see an compile time error, like
    Bareword "SUCCESS" not allowed while "strict subs" in use at ./ + line 9. Execution of ./ aborted due to compilation errors.
    but if I simply change the order of the use instructions, i.e. I run
    #!/usr/bin/perl use strict; use warnings; use Demo2; use Demo1; print "SUCCESS: ", SUCCESS, "\n"; print "\$SUCCESS: $SUCCESS\n"; exit;
    then the displayed result is the expected one,
    I'd love to understand what's happening here - and would bve grateful to learn if there is a way to not have to use the two modules in a strict order in order to have the code working nevertheless.

    Many thanks in advance.
How to pass a Format Heading from a variable?
3 direct replies — Read more / Contribute
by ankit.tayal560
on Oct 20, 2016 at 01:01
    SCRIPT TO GENERATE REPORT : use warnings; format DATA2= ------------------------------------------------------------ @<<<<<<<<<<<<< @<<<<<<<<< @######### @######## $name $format $matches $runs ------------------------------------------------------------ . format DATA2_TOP= Records/Data of the trio ============================================================ Name Format of match matches played runs scored ============================================================ . open(DATA,"<C:/Perl/perl_tests/sports.txt"); @array=<DATA>; close(DATA); open(DATA2,">>c:/perl/perl_tests/blank.txt"); foreach(@array) { chop; ($name,$format,$matches,$runs)=(split(/!/)); write(DATA2); }

    My sports.txt file is as follows:

    sports.txt file : sachin tendulkar!ODI!434!12000 sachin tendulkar!Test!246!10900 sachin tendulkar!T20!189!5000 sourav ganguly!ODI!334!8000 sourav ganguly!Test!235!5000 sourav ganguly!T20!124!1800 rahul dravid!ODI!387!9000 rahul dravid!Test!212!5980 rahul dravid!T20!43!1345

    The formatted report which I am getting in blank.txt is the final report I want but here in this script the heading of the report i.e. "records/data of the trio" is directly given. how can I pass a variable in place of that title.?Any Help is appreciated!

anyevent http 404code
1 direct reply — Read more / Contribute
by liuweichuan
on Oct 19, 2016 at 01:49

    why can not open this web page and return 404 code via anyevent::http. but LWP can get this page. then can open other web site page.

    use AnyEvent::HTTP; use AnyEvent; my @urls = qw( ); my $cv = AnyEvent->condvar; for my $url ( @urls ) { $cv->begin; http_get $url, sub { my ($data, $headers) = @_; foreach my $k (keys %$headers){ print $k," : ",$headers->{$k},"\n"; } $cv->end; } } $cv->recv;
Combinatorics formula
2 direct replies — Read more / Contribute
by BrowserUk
on Oct 18, 2016 at 19:20

    Update: Late breaking semi-possibility

    1. For M=3, N=2; (M*N)! := 720 and 720/90 = 8 (MN?)
    2. For M=3, N=3; (M*N)! := 362880 and 362880/1680 = 216. (But 33 is only 27) However, 63 :=216 ??? )
    3. For M=3, N=4; (M*N)! := 479001600 and 479001600/34650 = 13824. It's a whole number, so probably right, but how is it derived! ???

      Update2: 13824 is 29 * 33; but how you get that from 3 & 4 or 12 & 3 or 12 & 4???

    4. For M=3. N=4; (M*n)! := 1307674368000 and 1307674368000/7556756 = 1728000; And that is 29 * 33 * 53!?

    If you have N identical sets of M different things, how many different orderings can they be arranged in? (Ie. What's the formula?)

    Eg. if you have 2 sets of 3: my %stats; ++$stats{ join'', shuffle( ( 1..3 ) x 2 ) } for 1 .. 1e6

    For the above example, with M=3 and varying N, I gets the following numbers:

    1. N=2 => 90
    2. N=3 => 1680 (*18.6667)
    3. N=4 => 34650 (*20.625)
    4. N=5 => 756756 (*21.84)

    And for M=4:

    1. N=2 => 2520
    2. N=3 => 369600 (*146.6667)
    3. N=4 => 42283219 (at least; and probably much higher)

    And for M=5:

    1. N=2 => 113400
    2. N=3 => ??? (Too big for memory)

    Oh. And for the "What have you tried" crowd: I've been thinking about it for days; I've stared at the various algorithms in Algorithm::Combinatorics trying to work out which is applicable; and a few unsuccessful google searches looking for a relevant problem description.

    As you can see, the numbers compound very quickly; and I need to calculate for considerably higher numbers; but I cannot wrap my brain around it.

    For the very simplest (first) case above I get these results:

    If you count the number of 1s,2s,& 3s in the 6 columns they are all equal at 30; hence 90 possible comb/permutations. But if there was a free choice of digit for all positions; it would be 36==729 combinations.

    And if you could treat each group separately as permutations, and combined them it would be 3! * 3! = 36.

    At this point, I've run out of ideas, so ... this post.

    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority". I knew I was on the right track :)
    In the absence of evidence, opinion is indistinguishable from prejudice.
    /sup 114, 211332 =P
Installing module problem
3 direct replies — Read more / Contribute
by WisDomSeeKer34
on Oct 18, 2016 at 15:29

    I want to extract url's from an HTML on my harddrive. I want to install the module HTML:TokeParser. I think this is the module that will do the job. But then I get this message:

    $ cpan HTML::TokeParser requires configuration, but most of it can be done automatical +ly. If you answer 'no' below, you will enter an interactive dialog for eac +h configuration option instead. Would you like to configure as much as possible automatically? [yes] y +es Use of uninitialized value $what in concatenation (.) or string at /us +r/share/perl/5.20/App/ line 565, <STDIN> line 1. Warning: You do not have write permission for Perl library directories +. To install modules, you need to configure a local Perl library directo +ry or escalate your privileges. CPAN can help you by bootstrapping the loca +l::lib module or by configuring itself to use 'sudo' (if available). You may + also resolve this problem manually if you need to customize your setup. What approach do you want? (Choose 'local::lib', 'sudo' or 'manual')

    First question: will this module do the thing that I want it to do.

    Second question: what is the best thing to do? local::lib or sudo.

strict "vars" mode for hash key literals?
4 direct replies — Read more / Contribute
by perlancar
on Oct 18, 2016 at 11:32

    use strict "vars" is great and makes me more comfortable when writing Perl code compared to when I'm writing PHP, Python, or Ruby.

    However, since I utilize hashes a lot, typos made in the hash key literals that went undetected until runtime have at least one to several times bitten me.

    What would be the closest thing we have in Perl/CPAN for something like (pseudo-/imagined code below)?

    my %hash1; myhk @hash1{qw/foo bar baz/}; # define hash keys to use say $hash{foo}; # ok, declared say $hash{bah}; # compile-time error, undeclared say $hash{$var}; # ok, not literal
Compare complex perl data structures
4 direct replies — Read more / Contribute
by AnishaM
on Oct 16, 2016 at 07:12
    Hi Perl Monks, I am here again for your help.I have 2 complex data structures that need to be compared with each other.Each and every key/value pair needs to be compared. I made use of the Data::Compare module, but the problem I am unable to resolve is how do I sort these data structures before comparison? Please help me with this. Thanks a lot in advance. Here is my code:
    #!/usr/bin/perl use strict; use warnings; use Data::Compare; use Data::Dumper; my @array1 = [ {'platformid' => '22','da' => 'A.9','os' => 'hp-ux-11.31','host' => '2 +060','cc' => 'A.9','ma' => 'A.9','size' => [{'objecttype' => 'FILESYS +TEM','totalsize' => '3628129 KB','application' => '/depot','hostname' + => 'iwf1112060'}],'objecttype' => '2'}, {'platformid' => '100','da' => 'A.9','os' => 'microsoft amd64 wNT-6.1- +S','ma' => 'A.9','cc' => 'A.9','size' => [{'objecttype' => 'OB2BAR',' +totalsize' => '230986 KB','application' => 'IDB','hostname' => '5096' +},{'objecttype' => 'WINFS','totalsize' => '1262152 KB','application' +=> 'R: [New Volume]','hostname' => '5096'},{'objecttype' => 'WINFS',' +totalsize' => '574463 KB','application' => 'C:','hostname' => '5096'} +],'objecttype' => '6','host' => '5096'} ]; my @array2 = [ {'platformid' => '100','da' => 'A.9','os' => 'microsoft amd64 wNT-6.1- +S','ma' => 'A.9','cc' => 'A.9','size' => [{'objecttype' => 'OB2BAR',' +totalsize' => '230986 KB','application' => 'IDB','hostname' => '5096' +},{'objecttype' => 'WINFS','totalsize' => '1262152 KB','application' +=> 'R: [New Volume]','hostname' => '5096'},{'objecttype' => 'WINFS',' +totalsize' => '574463 KB','application' => 'C:','hostname' => '5096'} +],'objecttype' => '6','host' => '5096'}, {'platformid' => '22','da' => 'A.9','os' => 'hp-ux-11.31','host' => '2 +060','cc' => 'A.9','ma' => 'A.9','size' => [{'objecttype' => 'FILESYS +TEM','totalsize' => '3628129 KB','application' => '/depot','hostname' + => '2060'}],'objecttype' => '2'} ]; my @array3 = sort {$a->{platformid} cmp $b->{platformid} or $a->{da} c +mp $b->{da} or $a->{ma} cmp $b->{ma} or $a->{os} cmp $b->{os} or $a-> +{cc} cmp $b->{cc} or $a->{objecttype} cmp $b->{objecttype} or $a->{ho +st} cmp $b->{host} or $a->{size} cmp $b->{size}} @array1; my @array4 = sort {$a->{platformid} cmp $b->{platformid} or $a->{da} +cmp $b->{da} or $a->{ma} cmp $b->{ma} or $a->{os} cmp $b->{os} or $a- +>{cc} cmp $b->{cc} or $a->{objecttype} cmp $b->{objecttype} or $a->{h +ost} cmp $b->{host} or $a->{size} cmp $b->{size}} @array2; my $array1ref = \@array3; my $array2ref = \@array4; # print Dumper $array1ref; # print Dumper $array2ref; my $rc = Compare($array1ref,$array2ref); if($rc == 1) { print "Data structures are equal"; } else { print "Data structures are not equal"; }
Openssl upgrade in Strawberry Perl
2 direct replies — Read more / Contribute
by znasir
on Oct 15, 2016 at 06:16
    Hi Monks,

    Hope you are doing fine!

    I want to ask that how can I upgrade the Openssl from 0.9 to 1.0.* in Strawberry Perl version 5.10.*?

    PS: I do not want to upgrade the strawberry perl version as well as I am using windows environment. Thanks!

New Meditations
RFC: MVC::Neaf aka Not Even A Framework, part 2
No replies — Read more | Post response
by Dallaylaen
on Oct 18, 2016 at 16:10

    Hello dear fellow monks,

    After weeks of hesitation, I finally decided to share a piece of work called MVC::Neaf. Neaf [ni:f] stands for Not Even A Framework.

    It aims to keep things simple and straightforward, while maintaining some degree of separation between logic and presentation.

    Not to repeat myself, here's the original post.

    I know there's a lot to do, so I would appreciate any feedback. If you dare to try it out, please send bug reports and feature requests to github.


New Cool Uses for Perl
extracting strings from non-text files
1 direct reply — Read more / Contribute
by RonW
on Oct 20, 2016 at 21:09

    A coworker (on MS Windows) was cursing he couldn't see what symbol names might be hidden in a non-text configuration file for a proprietary, 3rd party tool he has to use. Since I didn't want to risk being constantly asked to "dump symbols" using my Lunix system, I took a few minutes to write the following program in Perl. Made him happy (for now, at least).

    Note: The tool being used only supports ASCII characters, so I didn't bother with encodings. Probably didn't need to specify ":bytes" in the open statement, but no harm in doing so.

    Maybe others will find this useful.

    #!perl use 5.010_000; use warnings; use strict; if ((@ARGV < 1)) { $0 =~ m#([^\\/]+$)#; my $name = $1 // $0; print STDERR "$name file ...\n" . <<'_DESCRIPTION_'; Extract ASCII strings from files listed. Multiple files allowed. _DESCRIPTION_ exit 1; } for my $file (@ARGV) { open my $fh, '<:bytes', $file or die "Error: Can't open '$file': $ +!\n"; my $buf; while (read $fh, $buf, 1024) { my @strings = split /\P{PosixGraph}/, $buf; for (@strings) { next if /^\s*$/; print "$_\n"; } } }
Fasta benchmark with multi-core processing via MCE
No replies — Read more | Post response
by marioroy
on Oct 17, 2016 at 01:01

    The following is a parallel demonstration for the fasta benchmark on the web. It runs nearly 3x faster versus the original code.

    Although nothing is relayed between workers, the relay capabilities in MCE is helpful for running a section of code orderly. A shared-scalar variable is used for retaining the $LAST value between chunks and subsequent runs.

    # perl 25000000 # The Computer Language Benchmarks game # # # contributed by Barry Walsh # port of fasta.rb #6 # # MCE version by Mario Roy use strict; use warnings; use feature 'say'; use MCE; use MCE::Candy; use MCE::Shared; use constant IM => 139968; use constant IA => 3877; use constant IC => 29573; my $LAST = MCE::Shared->scalar(42); my $alu = 'GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG' . 'GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA' . 'CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT' . 'ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA' . 'GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG' . 'AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC' . 'AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA'; my $iub = [ [ 'a', 0.27 ], [ 'c', 0.12 ], [ 'g', 0.12 ], [ 't', 0.27 ], [ 'B', 0.02 ], [ 'D', 0.02 ], [ 'H', 0.02 ], [ 'K', 0.02 ], [ 'M', 0.02 ], [ 'N', 0.02 ], [ 'R', 0.02 ], [ 'S', 0.02 ], [ 'V', 0.02 ], [ 'W', 0.02 ], [ 'Y', 0.02 ] ]; my $homosapiens = [ [ 'a', 0.3029549426680 ], [ 'c', 0.1979883004921 ], [ 'g', 0.1975473066391 ], [ 't', 0.3015094502008 ] ]; sub make_repeat_fasta { my ($src, $n) = @_; my $width = qr/(.{1,60})/; my $l = length $src; my $s = $src x (($n / $l) + 1); substr($s, $n, $l) = ''; while ($s =~ m/$width/g) { say $1 } } sub make_random_fasta { my ($table, $n) = @_; my $rand = undef; my $width = 60; my $prob = 0.0; my $output = ''; my ($c1, $c2, $last); $_->[1] = ($prob += $_->[1]) for @$table; $c1 = '$rand = ($last = ($last * IA + IC) % IM) / IM;'; $c1 .= "\$output .= '$_->[0]', next if $_->[1] > \$rand;\n" for @$ +table; my $code1 = q{ my ($mce, $seq, $chunk_id) = @_; # process code-snippet orderly between workers MCE->relay_recv; my $last = $LAST->get; my $temp = $last; # pre-compute $LAST for the next worker for (1 .. ($seq->[1] - $seq->[0] + 1) * $width) { $temp = ($temp * IA + IC) % IM; } $LAST->set($temp); MCE->relay; # process code-snippet in parallel for ($seq->[0] .. $seq->[1]) { for (1..$width) { !C! } $output .= "\n"; } # gather output orderly MCE->gather($chunk_id, $output); $output = ''; }; $code1 =~ s/!C!/$c1/g; MCE->new( bounds_only => 1, chunk_size => 2000, init_relay => 0, max_workers => 4, ## MCE::Util->get_ncpu || 4, sequence => [ 1, ($n / $width) ], gather => MCE::Candy::out_iter_fh(\*STDOUT), user_func => sub { eval $code1; }, use_threads => 0, )->run; $last = $LAST->get; $c2 = '$rand = ($last = ($last * IA + IC) % IM) / IM;'; $c2 .= "print('$_->[0]'), next if $_->[1] > \$rand;\n" for @$table +; my $code2 = q{ if ($n % $width != 0) { for (1 .. $n % $width) { !C! } print "\n"; } }; $code2 =~ s/!C!/$c2/g; eval $code2; $LAST->set($last); } my $n = $ARGV[0] || 27; say ">ONE Homo sapiens alu"; make_repeat_fasta($alu, $n*2); say ">TWO IUB ambiguity codes"; make_random_fasta($iub, $n*3); say ">THREE Homo sapiens frequency"; make_random_fasta($homosapiens, $n*5);

    Regards, Mario.

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 perusing the Monastery: (4)
As of 2016-10-22 02:57 GMT
Find Nodes?
    Voting Booth?
    How many different varieties (color, size, etc) of socks do you have in your sock drawer?

    Results (291 votes). Check out past polls.