Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

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
Any reason NV is not marked as POK when accessed as string?
2 direct replies — Read more / Contribute
by vr
on Mar 23, 2017 at 07:22

    Just curious, not a 'problem' which requires solution. Maybe developers thought real numbers stringification is usually approximate, that's why? Or simply nobody cares?

    C:\>perl -MDevel::Peek -e "$x = 0.5; qq/$x/; Dump $x" SV = PVNV(0x38bb4) at 0xd217cc REFCNT = 1 FLAGS = (NOK,pNOK) IV = 0 NV = 0.5 PV = 0xd16014 "0.5"\0 CUR = 3 LEN = 28 C:\>perl -MDevel::Peek -e "$x = 0; qq/$x/; Dump $x" SV = PVIV(0xd200c4) at 0xd2685c REFCNT = 1 FLAGS = (IOK,POK,pIOK,pPOK) IV = 0 PV = 0xd16274 "0"\0 CUR = 1 LEN = 10

    Hence, 'double' is converted to string any time it is required. E.g.:

    use Benchmark qw/ cmpthese /; $x = 42.0; %h = (); cmpthese( -1, { F => sub { $h{ pack 'F', $x } = 1 }, s => sub { $h{ $x } = 1 }, });
    Rate s F s 344025/s -- -86% F 2490475/s 624% --

    I found that one my little application, which maintains kind of 'seen' hash, gets nice boost if hash keys are packed as above, instead of 'just used as they are'. Actually, keys are pixels coordinates, they became real numbers because library I use returns them so. Pixels are usually aplenty and hash is accessed a lot, therefore speed gain was significant. But of course it would be even faster if PV was added on first access and POK was set, i.e. without packing.

Parse string and extract word after specific pattern
2 direct replies — Read more / Contribute
by rinkish85
on Mar 23, 2017 at 06:49

    Hi, I need to parse the below string

    stash_ST1.2.3.4_1.ROLLBACK.check.20170228-101051.435944.txt

    I am intrested only in part ROLLBACK.check

    Basically I am looking at what appears after "ROLLBACK" in above string.

    for e.g in this case its "check" .... that could be any word string like check2, check3, migration1, migration2.

    Thank you. Please suggest.
Search hash keys using vakues from array
4 direct replies — Read more / Contribute
by AhmedABdo
on Mar 23, 2017 at 06:36

    Hi dear all
    Assuming I have this array and hash.
    My @array = qw(world today is nice);
    my %hash = (0 => "Hello", 1=> "world" , 2=> "today" , 3=> "is" , 4=> "nice" );
    I want to search thought the hash values using the array elements as values and then print the hash keys for each searched value from the array in a new array.
    It should print 1 for world, 2 for today, so on which will be saved in the new array
    I tried to use lookup with loop thought the array but it did not work.
    I used grep also, but did not hot what I want
    Any idea about how I can do it???
    Thanks in advance

SOAP sign more elements
No replies — Read more | Post response
by makita
on Mar 23, 2017 at 04:56
    Hello, does heve anybode experience how to create a signature of more elements via XML::Compile::WSS ::Signature? This is my code:
    my $wsa = XML::Compile::SOAP::WSA->new(version => '1.0'); my $wsdl = XML::Compile::WSDL11->new("some.wsdl"); my $wss = XML::Compile::SOAP::WSS->new(schema => $wsdl); my $cert_obj = Crypt::OpenSSL::X509->new_from_file($cert); my $token = XML::Compile::WSS::SecToken::X509v3->new ( certificate => + $cert_obj,); my $sig = $wss->signature( schema => $wsdl, token => $token, sign_types=>['wsa:Action','wsa:To', 'wsu:Timestamp', 'wsa: +MessageID','SOAP-ENV:Body'], signer=>DSIG_RSA_SHA1, public_key => $cert, private_key =>$cert_pk, );
    My problem is that only 'SOAP-ENV:Body' is always signed as default even i set more types. Inside of source code I've found more parameters like sign_when and sign_put. Don;t know how to use it and documentation is very poor
url get with string
2 direct replies — Read more / Contribute
by bigup401
on Mar 23, 2017 at 04:34

    why if i post like this it doesn't work

    $name = 'john'; my $req = HTTP::Request->new(GET => 'https://www.google.com/?name=$nam +e'); $req->content_type('application/json');

    but it works when no $name string in url

    my $req = HTTP::Request->new(GET => 'https://www.google.com/?name=john +'); $req->content_type('application/json');
Mail - 32bit vs 64bit
3 direct replies — Read more / Contribute
by krausr
on Mar 22, 2017 at 08:57

    I have a script that emails me details from a file. The script works fine in a 32-bit version of Activeperl, but does not run using a 64-bit version. It seems to crap out on this line:

    $smtp->mail($email_from); # sender's address
  • Why would that ever be a case?
  • How can I fix this to work on either version?
  • use Net::SMTP; use Win32::EventLog; $summary = ''; $extra = ''; $begin_summary = 0; $data_file = "C:/Logs/myfile.log"; open(IN, $data_file) || die("Could not open file!"); @raw_data = <IN>; close(IN); for my $row (@raw_data) { if ( $row =~ /\s+Total\s+Copied\s+Skipped\s+Mismatch\s+FAILED\s+Ex +tras\s+/ ) { $begin_summary = 1; } if ( $begin_summary ) { $summary .= $row; } if ($row =~ /\s+Ended \: /) { #print "Exiting loop\n"; last; } } write_event(900, EVENTLOG_INFORMATION_TYPE, $summary); send_email("My Big Fat Notification - " . $ENV{COMPUTERNAME}, "$extra\ +n$summary"); sub send_email() { my ($subject, $body) = @_; my $email_from = 'fromster@frobot.com'; my $email_to = ('toster@frobot.com'); my $smtp = Net::SMTP->new('smtpserver.frobot.com'); # Connect to a +n SMTP server $smtp->mail($email_from); # sender's address $smtp->to($email_to); # Recipient's address $smtp->data(); # Start the mail # Send the header. $smtp->datasend("To: $email_to\n"); $smtp->datasend("From: $email_from\n"); $smtp->datasend("Subject: $subject\n"); $smtp->datasend("\n"); MORE CODE AFTER THIS...
Accessing the hash name in perl
5 direct replies — Read more / Contribute
by Sonali
on Mar 22, 2017 at 08:11

    Hello Perl monks,

    I am a Perl newbie

    I am try to get the name of the hash which is in another Perl file, and then access the hash elements, but when I run my program I am getting these errors

    Use of uninitialized value $line in pattern match (m//) at test.pm line 17.

    Use of uninitialized value $typ_s in string at test.pm line 20.

    My code goes like this

    package hash; use strict; use warnings; $test = { 'hash1' => { 'paramA' => '00' , 'paramB' => 'FF' , }, 'hash2' => { 'paramA' => '01' , 'paramB' => '02' , }, 'hash3' => { 'paramA' => '00' , 'paramB' => '03' , }, };

    This hash structure is generated, so I can't modify it

    This the Perl file which contains the hash that needs to be extracted

    This is the Perl script I have written to extract the hash

    #!/usr/local/bin/perl use strict; use warnings; Generate(); sub Generate { Process_File('hash.pm'); } sub Process_File { my $filename = shift; open(my $fh, '<:encoding(UTF-8)', $filename) or die "Could not open file '$filename' $!"; my $line; $line =~ m/\'hash1\'/; my $typ_s = $line->{paramA}; my $paramB = $line->{paramB}; print "$typ_s"; }

    Help me!

CPAN::Mini on a diet
2 direct replies — Read more / Contribute
by glasswalk3r
on Mar 21, 2017 at 19:14

    Hello follow monks,

    Are you aware of any technique to reduce the size of a CPAN::Mini repository?

    I was checking my local mirror here and it is around 4.9Gb on a OpenBSD 6 box with FFS.

    Taking a look at my ID under authors directory, I see that there are tarballs over there that are not even listed on my PAUSE account anymore (might be some issue regarding mirror synchronization). Anyway, I guess that for my purposes I could use only the latest available distribution for everybody.

    A quick check on CPAN::Mini and minicpan documentation doesn't show anything that would help with that.

    Is there any trick to take care of it?

    Thanks!

    UPDATED

    I tried this:

    Still pending to validate if it didn't break anything...

    Anyway, I was able to reduce it to 3.0Gb from the initial 4.9Gb...

    Alceu Rodrigues de Freitas Junior
    ---------------------------------
    "You have enemies? Good. That means you've stood up for something, sometime in your life." - Sir Winston Churchill
Directory Structure Recommendations
3 direct replies — Read more / Contribute
by Ossie
on Mar 20, 2017 at 08:14

    Hi Folks

    As a newbie to Perl I'm seeking guidance about directory structure that is good practice, as I've not yet found it in the various documents I've looked at.

    My primary objective is to run a program (Mapivi) under Perl on a Windows PC (I'll write my own additional code at later stage).

    I've successfully installed Strawberry Perl and downloaded Mapivi together with other necessary files such as Perl/Tk and Image-MetaData-JPEG.

    So what (if any) additional directories should I create to hold the various files when I unpack them, prior to running the usual sequence of Makefile & Test & Install, and should the resulting files be put into specific directories?

    If there are existing publications covering this then I'd be grateful if you point me in their direction, as well as giving the benfit of your experience.

    Related follow-on questions may then be about what has to be manually added to PATH and @INC

    Thanks

how to align the label and entry text box in my tk GUI
9 direct replies — Read more / Contribute
by fsmendoza
on Mar 20, 2017 at 03:22

    Dear Perlmonk experts,

    I'm designing my simple GUI and i could not find a way to get rid of the spaces between the label and entry box in my output GUI and align them. Please advice on what will be the best way to do this.

    Thank you.

    use strict; # module to must always declare variabl +es before you use them use warnings; # module to show where is the error use Tk; # module for the Windows GUI my $mainwindow = MainWindow->new(); $mainwindow->geometry("600x150"); $mainwindow->title("Window"); # Disable the window Resize $mainwindow->resizable(0,0); # Menu display option my $main_menu = $mainwindow->Menu(); $mainwindow->configure(-menu => $main_menu); #File my $file_menu = $main_menu->cascade(-label=>"File", -underline => 0, - +tearoff=>0); $file_menu->command(-label=>"New", -underline=>0, -command=>sub{exi +t}, -state => 'disabled'); $file_menu->command(-label=>"Exit", -underline=>0, -command=>sub{ex +it}); # About $main_menu->command(-label=>"About", -command=>sub{$mainwindow->messag +eBox(-title=> "About", -message=>"Version 3.0.0", -type => "ok")}); # text variable my $label_firstname; my $entry_firstname; my $label_lastname; my $entry_lastname; my $label_loginid; my $entry_loginid; my $button_add; # -anchor => 'e' | 'w' | 'n' | 's' | 'ne' | 'nw' | 'se' | 'sw' | 'cen +ter' # top ################################ # nw n ne # # # # w center e # # # # sw s se # ################################ # bottom $label_firstname = $mainwindow->Label(-text => 'Firstname:')->pack (-a +nchor => 'nw'); $entry_firstname = $mainwindow->Entry(-width => 35,-text => 'Firstname +')->pack (-anchor => 'n' ); $label_lastname = $mainwindow->Label(-text => 'Lastname:')->pack (-anc +hor => 'nw'); $entry_lastname = $mainwindow->Entry(-width => 35,-text => 'Lastname') +->pack (-anchor => 'n'); $label_loginid = $mainwindow->Label(-text => 'Login ID:')->pack( -anch +or => 'nw'); $entry_loginid = $mainwindow->Entry(-width => 35,-text => 'loginID')-> +pack (-anchor => 'n'); $button_add = $mainwindow->Button(-text => 'Add New User', -command=>s +ub{exit})->pack(-anchor => 'se'); MainLoop();
Using ActivePerl and Strawberry simultaneously
3 direct replies — Read more / Contribute
by dhannotte
on Mar 20, 2017 at 00:20

    I recently upgraded my version of 64-bit ActivePerl from version 5.10.1.1007 to 5.22.2.2203, and am having tons of problems with it.

    I'd really rather jump to Strawberry, but I'll have to test it first on each of the critical Perl apps I run on a daily basis.

    Can I install the portable version of Strawberry and test it out while continuing to use the ActivePerl version for production work?

Fastest way of XML -> perl structure
5 direct replies — Read more / Contribute
by sectokia
on Mar 19, 2017 at 18:16

    Hi wise monks,

    What is the fastest way to go from XML to perl? I have 16MB+ XML files that are taking many seconds.

    I have tried XML::Simple XML::Fast and XML::Bare, but all are surprisingly slow. Normalised its: Simple 1.0, fast 0.55, bare 0.4. But even then, that seems rediculously slow, with 3GHz machines still taking 10+ seconds.

    In comparison, I wrote a dodgy C program that takes the XML and outputs a eval'able perl literal structure of nested array/hashes. Running the program and eval'ing the output is nearly 3x faster than xml::bare!

    However I feel like I am re-inventing the wheel here (my dodgy program doesn't support attributes) and people must know a fast way to go from xml to perl already?

    My other question is: Since eval is where most of the processing time is, is there some sort of 'direct' memory format for perl? For example: I would like my C program to output a 'memory blob' of nested arrays/hashes/scalers that would go straight into Perl, without having to 'parse'/'eval' anything.

    The structures I want to put in are mostly like this:

    {'elements' => [ 'element' => { 'item' => 'value', 'item2' => 'value' } , 'element2' => { 'item' => 'value', 'item2' => 'value' } , ] , 'elements2' => [ 'element' => { 'item' => 'value', 'item2' => 'value' } , 'element2' => { 'item' => 'value', 'item2' => 'value' } , ] }
New Meditations
OT: Got fired this week
4 direct replies — Read more / Contribute
by karlgoethebier
on Mar 23, 2017 at 05:43

    As i'm aged 60 + i guess i'll never get a new job. I think i need to face retirement. I first thought to delete my account on PM and through away all the code i ever wrote as well as my hand library and forget about everything related to programming. But it isn't so easy. I spent the last 20 years with this stuff. I'll stay a bit here - for fun. And perhaps i'll learn a new programming language ;-)

    Best regards, Karl

    «The Crux of the Biscuit is the Apostrophe»

    Furthermore I consider that Donald Trump must be impeached as soon as possible

New Cool Uses for Perl
Mutex::Flock - Fcntl advisory locking supporting processes and threads.
1 direct reply — Read more / Contribute
by marioroy
on Mar 23, 2017 at 02:59

    Greetings,

    Re: Scheduling Perl Tasks

    This is a nice to have module for anybody that wants it. Lately, I lack the time to make a module and publish on CPAN. It is well tested on all supported platfoms including support for threads. It is also optimized, thus low overhead.

    ## Mutex::Flock - Fcntl advisory locking. package Mutex::Flock; use strict; use warnings; no warnings qw( threads recursion uninitialized once ); our $VERSION = '0.001'; use Fcntl ':flock'; use Carp (); my $_has_threads = $INC{'threads.pm'} ? 1 : 0; my $_tid = $_has_threads ? threads->tid() : 0; sub CLONE { $_tid = threads->tid() if $_has_threads; } sub DESTROY { my ($_pid, $_obj) = ($_has_threads ? $$ .'.'. $_tid : $$, @_); $_obj->unlock(), close (delete $_obj->{_fh}) if $_obj->{ $_pid }; unlink $_obj->{path} if ($_obj->{_init} eq $_pid); return; } sub _open { my ($_pid, $_obj) = ($_has_threads ? $$ .'.'. $_tid : $$, @_); return if exists $_obj->{ $_pid }; open $_obj->{_fh}, '+>>:raw:stdio', $_obj->{path} or Carp::croak("Could not create temp file $_obj->{path}: $!") +; return; } ## Public methods. my ($_id, $_prog_name) = (0); $_prog_name = $0; $_prog_name =~ s{^.*[\\/]}{}g; $_prog_name = 'perl' if ($_prog_name eq '-e' || $_prog_name eq '-'); sub new { my ($_class, %_obj) = (@_, impl => 'Flock'); if (! defined $_obj{path}) { $_obj{_init} = $_has_threads ? $$ .'.'. $_tid : $$; my ($_pid, $_tmp_dir, $_tmp_file) = ( abs($$) ); if ($ENV{TEMP} && -d $ENV{TEMP} && -w _) { $_tmp_dir = $ENV{TEMP}; } elsif ($ENV{TMPDIR} && -d $ENV{TMPDIR} && -w _) { $_tmp_dir = $ENV{TMPDIR}; } elsif (-d '/dev/shm' && -w _) { $_tmp_dir = '/dev/shm'; } elsif (-d '/tmp' && -w _) { $_tmp_dir = '/tmp'; } else { Carp::croak("no writable dir found for temp file"); } $_id++, $_tmp_dir =~ s{/$}{}; # remove tainted'ness from $_tmp_dir if ($^O eq 'MSWin32') { ($_tmp_file) = "$_tmp_dir\\$_prog_name.$_pid.$_tid.$_id" = +~ /(.*)/; } else { ($_tmp_file) = "$_tmp_dir/$_prog_name.$_pid.$_tid.$_id" =~ + /(.*)/; } $_obj{path} = $_tmp_file.'.lock'; } else { $_obj{path} =~ s{\.lock$}{}; $_obj{path} .= '.lock'; } # ensure file creation is possible open my $_fh, '+>:raw:stdio', $_obj{path} or Carp::croak("Could not create temp file $_obj{path}: $!"); close $_fh; chmod 0600, $_obj{path}; return bless(\%_obj, $_class); } sub lock { my ($_pid, $_obj) = ($_has_threads ? $$ .'.'. $_tid : $$, @_); $_obj->_open() unless exists $_obj->{ $_pid }; flock ($_obj->{_fh}, LOCK_EX), $_obj->{ $_pid } = 1 unless $_obj->{ $_pid }; return; } *lock_exclusive = \&lock; # alias for lock sub lock_shared { my ($_pid, $_obj) = ($_has_threads ? $$ .'.'. $_tid : $$, @_); $_obj->_open() unless exists $_obj->{ $_pid }; flock ($_obj->{_fh}, LOCK_SH), $_obj->{ $_pid } = 1 unless $_obj->{ $_pid }; return; } sub unlock { my ($_pid, $_obj) = ($_has_threads ? $$ .'.'. $_tid : $$, @_); flock ($_obj->{_fh}, LOCK_UN), $_obj->{ $_pid } = 0 if $_obj->{ $_pid }; return; } sub synchronize { my ($_pid, $_obj, $_code, @_ret) = ( $_has_threads ? $$ .'.'. $_tid : $$, shift, shift ); return if ref($_code) ne 'CODE'; $_obj->_open() unless exists $_obj->{ $_pid }; # lock, run, unlock - inlined for performance flock ($_obj->{_fh}, LOCK_EX), $_obj->{ $_pid } = 1 unless $_obj-> +{ $_pid }; defined wantarray ? @_ret = $_code->(@_) : $_code->(@_); flock ($_obj->{_fh}, LOCK_UN), $_obj->{ $_pid } = 0; return wantarray ? @_ret : $_ret[-1]; } *enter = \&synchronize; # alias for synchronize 1; __END__ =head1 NAME Mutex::Flock - Fcntl advisory locking =head1 SYNOPSIS # threads demonstration use threads; use Mutex::Flock; my $mutex = Mutex::Flock->new; sub task { my ($id) = @_; $mutex->lock; # access shared resource print $id, "\n"; sleep 1; $mutex->unlock; } threads->create('task', $_) for 1..4; $_->join for ( threads->list ); # MCE demonstration use MCE::Flow max_workers => 4; use Mutex::Flock; my $mutex = Mutex::Flock->new; mce_flow sub { $mutex->lock; # access shared resource MCE->say( MCE->wid ); sleep 1; $mutex->unlock; }; =head1 DESCRIPTION This module implements locking methods that can be used to coordinate +access to shared data from multiple workers spawned as processes or threads. =head1 API DOCUMENTATION =head2 Mutex::Flock->new ( [ path => "/tmp/file.lock" ] ) Creates a new mutex. When path is given, it is the responsibility of c +aller to remove the file. Otherwise, it establishes a temp file autom +atically. That file is removed by the originating process or thread o +nly upon termination. =head2 $mutex->lock ( void ) Attempts to grab the lock and waits if not available. Multiple calls t +o mutex->lock by the same process or thread is safe. The mutex will rema +in locked until mutex->unlock is called. =head2 $mutex->unlock ( void ) Releases the lock. A held lock by an exiting process or thread is rele +ased automatically. =head2 $mutex->synchronize ( sub { ... }, @_ ) =head2 $mutex->enter ( sub { ... }, @_ ) Obtains a lock, runs the code block, and releases the lock after the b +lock completes. Optionally, the method is C<wantarray> aware. my $val = $mutex->synchronize( sub { # access shared resource return 'scalar'; }); my @ret = $mutex->enter( sub { # access shared resource return @list; }); The method C<enter> is an alias for C<synchronize>. =head1 AUTHOR Mario E. Roy, S<E<lt>marioeroy AT gmail DOT comE<gt>> =cut

    Regards, Mario

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
[Discipulus]: oh well we cant afford two monks fired in a day!
[LanX]: any news from tye ' s search?
[MidLifeXis]: Ugh - who else?
[Discipulus]: so the right term is 'gired'
[Discipulus]: look at ot by karl
Discipulus gired: adj the work position that stands between hired and fired..
LanX recommends inner immigration, work less hard and enjoy pay roll
[MidLifeXis]: ahh, yeah, didn't look through nodes yet today.
[erix]: haha
[MidLifeXis]: Ahh well, time to get back to it, so there isn't a reason to take that choice out of my hands :-)

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (14)
As of 2017-03-23 12:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Should Pluto Get Its Planethood Back?



    Results (286 votes). Check out past polls.