Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic

Seekers of Perl Wisdom

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

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
tinyDNS deconstruct.
2 direct replies — Read more / Contribute
by 0xdeadbad
on Feb 15, 2018 at 12:40

    Could somebody lend a hand with deconstructing tinydns CAA records please.

    "\000\" > "CAA IN 0 issue" [flag] [tag] [issuer]

    The first octal is the Flag ( 000 )
    The second octal ( 005 ) is the taglength and used to deduce the tag and issuer from the ascii string.

    If I could just get "\000\" translated to "0,5," that would be a great help. I've been looking at pack and unpack but cannot work it out as I'm not a real programmer.

    many thanks
Use function as a regex
4 direct replies — Read more / Contribute
by stevieb
on Feb 15, 2018 at 11:22

    I've got a very large and complex distribution where several of the modules use a pretty high number of somewhat complex regexes. I have decided instead of having them peppered throughout the code, I'd create a new module, that would house and return these regexes based on name.

    Now, this all works well and fine after some fiddling and learning where certain flags need to be set. Here is a basic example:

    use warnings; use strict; package Re; { my %h = ( re => qr/ [Pp]erl-\d\.\d+\.\d+(?:_\w+)? \s+===.*? (?=(?:[Pp]erl-\d\.\d+\.\d+(?:_\w+)?\s+===|$)) /xs, ); sub re { return $h{re}; } } package main; { my $str; { local $/; $str = <DATA>; } my $re = Re::re(); my @results = $str =~ /$re/g; print scalar @results; } __DATA__ perl-5.26.1 ========== Reading '/home/spek/.cpan/Metadata' Database was generated on Tue, 13 Feb 2018 15:29:02 GMT App::cpanminus is up to date (1.7043). --> Working on . Configuring /home/spek/repos/mock-sub ... OK <== Installed dependencies for .. Finishing. --> Working on . Configuring /home/spek/repos/mock-sub ... Generating a Unix-style Make +file Writing Makefile for Mock::Sub Writing MYMETA.yml and MYMETA.json OK Building and testing Mock-Sub-1.10 ... Skip blib/lib/Mock/ (unch +anged) Skip blib/lib/Mock/Sub/ (unchanged) Manifying 2 pod documents PERL_DL_NONLAZY=1 "/home/spek/perl5/perlbrew/perls/perl-5.26.1/bin/per +l" "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Har +ness::Switches; test_harness(0, 'blib/lib', 'blib/arch')" t/*.t t/00-load.t .................... ok t/01-called.t .................. ok t/02-called_count.t ............ ok t/03-instantiate.t ............. ok t/04-return_value.t ............ ok t/05-side_effect.t ............. ok t/06-reset.t ................... ok t/07-name.t .................... ok t/08-called_with.t ............. ok t/09-void_context.t ............ ok t/10-unmock.t .................. ok t/11-state.t ................... ok t/12-mocked_subs.t ............. ok t/13-mocked_objects.t .......... ok t/14-core_subs.t ............... ok t/15-remock.t .................. ok t/16-non_exist_warn.t .......... ok t/17-no_warnings.t ............. ok t/18-bug_25-retval_override.t .. ok t/19-return_params.t ........... ok t/manifest.t ................... skipped: Author tests not required fo +r installation t/pod-coverage.t ............... skipped: Author tests not required fo +r installation t/pod.t ........................ skipped: Author tests not required fo +r installation All tests successful. Files=23, Tests=243, 2 wallclock secs ( 0.13 usr 0.04 sys + 1.75 cu +sr 0.13 csys = 2.05 CPU) Result: PASS OK Successfully tested Mock-Sub-1.10

    In the code, I've got this:

    my $re = Re::re(); my @results = $str =~ /$re/g;

    What I'm wondering, and haven't been able to sort out if it's possible, is skip the variable instantiation, and use the function call directly when using the regex, like this:

    my @results = $str =~ /Re::re()/g;

    Doable, or am I chasing down something impossible?

user net:openSSH and File::find::Rule together.
1 direct reply — Read more / Contribute
by garcimo
on Feb 15, 2018 at 09:52
    Hello I would like to search files in a remote system that match certain pattern that are older than one hour. the remote system is solaris. the find in solaris does not have parametres like mmtime. so I created this script that does more or less what i want in the remote system.
    #!/usr/bin/perl use File::Find::Rule; use POSIX qw(strftime); my $today = time(); my $onehour = $today - (60*60); my @files = File::Find::Rule->file() ->name("*.0") ->mtime("<$onehour") ->in( "/mypath/" ); for my $file (@files) { print "$file\n"; }
    now I want to use from a remote system using net:openssh so that it connects to the solaris with ssh finds the file and gives me the output..
    use Net::OpenSSH; my $dir = '/mypath'; my $host = 'myhost'; my $ssh = Net::OpenSSH->new($host, user => adm_garcimo); $ssh->error and die "Couldn't establish SSH connection: ". $ssh->error;
    is there a way to merge the two script in one central server without having to scp the scripts to all the hosts that the script needs to find files... I hope imy question is clear
Alternative to Email::Sender
1 direct reply — Read more / Contribute
by Anonymous Monk
on Feb 15, 2018 at 09:14

    Hello monks

    I need to send (SMTP) an email from a perl script packed in an exe. I've been able to achieve my goal with Email::Sender and the code below. However, I have problems in packaging it using ActivePerl/PerlApp since - no matter how many tricks I use (manually adding modules, etc.) - I end up missing the module Email::Sender::Role::CommonSending (Error: Can't locate Email/Sender/Role/ in @INC). It is installed, it is scanned by PerlApp (added manually)... but the exe is missing it. The second script throughs error, but it doesn't say what is wrong.

    Now I am searching for an alternative to the modules Email::Sender and Email::Send::SMTP::Gmail. What can you suggest?

    This is the code I can not pack in exe(I can not switch to pp, sorry)

    use strict; use warnings; use Email::Sender::Simple qw(sendmail); use Email::Sender::Transport::SMTP (); use Email::Simple::Markdown; use Email::Simple::Creator (); my $smtpserver = 'Myserver'; my $smtpport = 25; my $smtpuser = ''; my $smtppassword = '0123456789'; my $transport = Email::Sender::Transport::SMTP->new({ host => $smtpserver, port => $smtpport, sasl_username => $smtpuser, sasl_password => $smtppassword, }); my $email = Email::Simple::Markdown->create( header => [ To => '', From => '', Subject => 'Subject', ], body => "My body", ); sendmail($email, { transport => $transport });

    This is the code with Email::Send::SMTP::Gmail which I can pack but it doesn't work stable for me (error is printed out but $error is empty , so I cannot understand what is wrong)

    use strict; use warnings; use Email::Send::SMTP::Gmail; my ($mail,$error) = Email::Send::SMTP::Gmail->new( -layer =>'tls', -port =>'25', -smtp =>'myserver(not gmail)', -login =>'', -pass =>'?????' ); die "session error: $error" if $mail ==-1; $mail->send( -to =>'', -subject =>'Hello!', -body =>'Just testing it', ); $mail->bye;

    What are good alternatives (and possibly easy to use)? Thank

Running a perl script with root, changing to another user and then back to root?
4 direct replies — Read more / Contribute
by morthed
on Feb 15, 2018 at 09:13

    I've tried to search a lot around the web for this question, to no avail. <\p>

    Currently I'm building a perl script that needs to do a specific job for each line in some database. The database contains several arguements including a "user" field. The script runs as root, and in each line iteration in the db, it will need to switch to the user provided and operate as the user, finishing the round and exiting back to root and then again, running as a different user. <\p>

    So far I've tried: <\p>

    using POSIX::setuid($User) in order to switch to the user within the same script, meaning:<\p><code>while (my $line = <$DB>) .. some code .. POSIX::setuid($User); #switch to user ... do stuff POSIX::setuid(0); #return to root <\code>

    But this solution didn't work so well, after changing once it was stuck in this user through all iterations of the loop, and couldn't return to root, which is obviously logical because it doesn't have the correct permissions.<\p>

    Since this didn't work, I thought to myself maybe I should split the job into 2 scripts. One script will run as root, whereas the other script will be called to by root in the first script and then use POSIX::setuid. I thought, that maybe because it's a subproc\shell it'll just return itself back to root once the job is done on the second script, but it doesn't work as well... I'm kinda out of ideas, anything you guys think'll help?<\p>

    ANOTHER THING: I know this is probably incorrect, so that's why I ask this around... please keep mean comments off or stuff like "you don't know what you're doing", if I did I wouldn't have asked... I basically look for a safe way to change the eid\uid of the SECOND SCRIPT only and keep root as the user for the main one... is there a way for that? Thanks! <\p>

Replacing XML::Simple XMLout with Lib::XML
3 direct replies — Read more / Contribute
by amasidlover
on Feb 15, 2018 at 06:49

    As per accepted wisdom we've replaced XMLin with XML::LibXML - there are places where its made life easier and places where its made life harder but overall its been a positive change (its also quite a lot faster.)

    However, we're now looking at XMLout - we currently do XMLout($some_big_hashref, options) and then put the output through XSL - and before anyone suggests JSON, Template::Toolkit etc. as alternatives; we do use those but in other parts of our system.

    So I got a newly recruited developer to knock together a 'quick and dirty' test script to see a) how to do it and b) the performance impact. We started with an XML::Simple section as a benchmark:

    package MyXMLSimple; use base 'XML::Simple'; sub sorted_keys { my ( $self, $name, $hashref ) = @_; return sort { ma +in::element_order($a) <=> main::element_order($b) } keys(%{$hashref}) +; }; ... SNIP ... return $parser->XMLout($xml, KeyAttr => [], RootName => 'Zymonic', NoEscape => 1, SuppressEmpty => 1 );

    Then we did a LibXML version...

    sub add_nodes_hash { #first time $xml will be the file, after that it will be the hash +or array ref # $is_child is a flag to see if it wants to be added as like a roo +t node, or part of a nest my $xml = shift; my $parent_element = shift; foreach my $node (sort {element_order($a) <=> element_order($b)} k +eys %{$xml}) { #next if ($node =~/\//); if (ref($xml->{$node}) eq 'HASH') { my $element = $dom->createElement( $node ); $parent_element->insertAfter($element,undef); add_nodes_hash($xml->{$node},$element); } if (ref( $xml->{$node} ) eq 'ARRAY') { foreach my $array_element (@{$xml->{$node}}) { if (ref($array_element) eq 'HASH') { my $element = $dom->createElement( $node ); my @attributes = $element->attributes(); $parent_element->insertAfter($element,undef); add_nodes_hash($array_element,$element); } elsif (!ref( $xml->{$node} ) && ($xml->{$node})) { my $element = $dom->createElement( $node ); $element->appendText($xml->{$node}); $parent_element->insertAfter($element,undef); } } } elsif (!ref( $xml->{$node} ) && ($xml->{$node})) { my $element = $dom->createElement( $node ); $element->appendText($xml->{$node}); $parent_element->insertAfter($element,undef); } } return $dom; } sub libxml_output { my $xml = shift; #create the dom object $dom = XML::LibXML::Document->new(); my $root = $dom->createElement('Zymonic'); $dom->setDocumentElement($root); add_nodes_hash($xml, $root); return $dom->toString(1); }

    When we generate 3000 lines of XML (approximately) we get the following timings.

    ====================TIMINGS======================= LibXML time for 100 rep(s): 5409.750 ms XML Simple time for 100 rep(s): 3699.437 ms

    I'll put the full test script code in a reply to this node in case it helps - but didn't want to add it all for brevity

    Now before I ask my specific questions, I'll add some caveats / further info:

    • I haven't checked the code thoroughly myself and I know it doesn't do anything with attributes yet; but it looks roughly ok (including the output looking ok) and I can't see it getting faster when we add attributes
    • If we were starting from scratch there would be a strong argument for assembling the elements as we went along rather than coverting a giant hashref at the end; however, we're not starting from scratch and the 'giant hashref' approach means we can also go straight to JSON and Storable using if/elsif / polymorphism as appropriate with the same code generating the hashref - and arguably we could have added a polymorphic output module that had methods that were analogous to adding elements / nodes and that had JSON and XML sub-classes - but again that's too big a rewrite for us to realistically contemplate.

    Finally, my actual question(s)... Have we made a fundamental error somewhere and there is a way of going from XMLout to something 'better' whilst retaining equivalent (or better!) performance and keeping the code nice and simple? Ideally a method that we can use a one liner to go from nested hashref to XML output.

Blockchain and Perl
1 direct reply — Read more / Contribute
by baxy77bax
on Feb 15, 2018 at 05:46

    This is just an info question. In light of blockchain "crazies" I was wondering are there any tutorials on how to make your own with Perl or something, anything related. How to make a Dapp maybe? I seen there was a post (here) 2 years ago on the subject but I could not find any recent posts. I, myself am not very familiar with the tech but would love to learn and if possible to learn it through perl, that would be awesome :)

    Thank you !

Help with $File:Find
3 direct replies — Read more / Contribute
by roperl
on Feb 14, 2018 at 13:29
    I'm using the File::Find module to find files that matches a certain type

    Occasionally I get this in my STDERR log : "Use of uninitialized value $_ in pattern match (m//)" when using the code below
    find( { wanted => \&get_files, preprocess => \&nodirs }, "$DIR" ) +; sub nodirs { grep !-d, @_; } sub get_files { my @array; push @array, $File::Find::name if ( (/^.*\.($TYPES)$/i) ); }
    How can I check if $_ is initalized before matching the pattern?
Strange memory growth
5 direct replies — Read more / Contribute
by spica1001
on Feb 14, 2018 at 13:02

    Hi all. Here's an odd one, to me anyway. I'm running a script to process very large XML files with embedded JSON. When I run it, the memory increases indefinitely (the file can be 100s of GB and the RAM usage reaches 25GB+). Boiling it down, I reach the below. If I remove the line marked "## THIS LINE", the memory remains static, but leave it in and it increases again. Adding in a load of undefs seems to make no difference. It's evidently leaving the hash array around, but I can't see how to 'free' it.

    Why would accessing a non-existent hash value cause that, or of course even better how do I prevent it?! Thanks for any help...

    use JSON; open(IN,"<:utf8","$ARGV[0]"); while(<IN>) { if (m!^\s+<text.*?>({[^\{\|].+})</text>!) { my $jt = $+; $jt=~s/\&quot;/\"/g; my $json = new JSON; my $jp = $json->allow_nonref->utf8->relaxed->decode($jt); my $c = $jp->{'claims'}; # "claims":{"P31":[{"mainsnak":{"snaktype":"value","property": +"P31","hash":"...","datavalue":{"value":{"entity-type":"item","numeri +c-id":5},...}... }...}], if (ref($c) eq 'HASH') { foreach my $ch (keys %$c) { if (ref($c->{$ch}) eq 'ARRAY') { foreach my $cg (@{$c->{$ch}}) { if (defined $cg->{'mainsnak'}->{'datavalue'}-> +{'value'}->{'notexist'}) {} ## THIS LINE } } } } } }


    UPDATE: Thanks to all the replies, I've worked it out now.

    Points should go to tinita as the suggestion of use strict pointed me in the right direction. It turned out that, in some of the lines that my script reads, the value $cg->{'mainsnak'}->{'datavalue'}->{'value'} is a string, not a hash. It seems treating a string as a hash causes the memory growth. I fixed it with:

    if (ref($cg->{'mainsnak'}->{'datavalue'}->{'value'}) eq 'HASH' && defined $cg->{'mainsnak'}->{'datavalue'}->{'value'}->{'notexist'}) {}

    (Of course my code does plenty else besides this, but the principle of needing to check that a variable is indeed a hash before checking for a key is the main takeaway here.)

search and return values from an array
3 direct replies — Read more / Contribute
by Gtforce
on Feb 14, 2018 at 11:30

    I have an @array where a=stock and b=value.

    a1 b1 a2 b2 a3 b3 a5 b5 a4 b4

    My objective is to find the stock in the array and get its corresponding value for further printing or processing. When I use something like this:

    my $stockval = grep{/a2/} @array;

    I get a '1' in my $stockval. I'm guessing that I'm only being told about whether a2 exists in the array or not. What should I be doing to get a2's corresponding value b2 into my $stockval? I realize that this probably a very rookie question (am new to perl). Thanks.

Add your question
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • 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 studying the Monastery: (3)
    As of 2018-02-19 22:30 GMT
    Find Nodes?
      Voting Booth?
      When it is dark outside I am happiest to see ...

      Results (266 votes). Check out past polls.