Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?

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
Idiomatic Perl?
3 direct replies — Read more / Contribute
by thenextfart
on Mar 20, 2018 at 10:06
    I am currently learning Perl by trial/try/error, and I have a Python background. The purpose of the program of the subject of the question, however, is to find out what is idiomatic Perl and what is not. I don't want to end up writing Python in Perl. This is my program:
    use strict; use warnings; print "RegEx Engine 1.0\n________________\n"; print "Gimme a string: "; my $str = <STDIN>; print "Gimme a RegEx: "; my $pattern = <STDIN>; my $answer = eval("\"$str\" =~ $pattern"); if ($answer) { print "Yes!"; } else { print "No."; } print "\nkthxbye\n";
    Is this good/idiomatic/bad/ugly/encouraged/discouraged/ Perl? (Note: I am using Perl 5)
Date to Epoch
4 direct replies — Read more / Contribute
by Anonymous Monk
on Mar 20, 2018 at 09:51

    I am trying to convert a file date to epoch using a single line of code in Solaris 10, which uses an older version of perl.

    I have been able to convert epoch to a date with your assistance:

    echo $epoch | perl -MPOSIX -e 'print strftime("%m%d%H%M", gtime <stdin>)'

    However, I would like to now reverse this process.

    I was thinking about something like the following:

    echo "Mar 20 2018 09:00" | perl -MPOSIX -e 'print strptime(<stdin>, "%s")'

    But, I receive an error "Undefined subroutine &main::strptime called at -e line 1, <stdin> line 1. I tried substituting <stdin> with $ARGV[0] but still receive a subroutine error.

Error running Gitlab CI pipeline on module
1 direct reply — Read more / Contribute
by loris
on Mar 20, 2018 at 05:54


    I'm jumping on the CD/CI bandwagon and have set up a Gitlab instance, created a new module with module-starter, and pushed it to the remote. In my local repository, running prove -l t works fine. I then added and pushed a .gitlab-ci.yml file with the following contents:

    stages: - test job 1: stage: test script: prove -l t tags: - perl

    The pipeline runs but fails with the following error:

      TAP::Object::_construct(TAP::Harness=HASH(0x5608cb0c3e98), "TAP::Parser", HASH(0x5608cb64f990)) called at /usr/share/perl/5.24/TAP/ line 852
            TAP::Harness::make_parser(TAP::Harness=HASH(0x5608cb0c3e98), TAP::Parser::Scheduler::Job=HASH(0x5608cb80a480)) called at /usr/share/perl/5.24/TAP/ line 651
            TAP::Harness::_aggregate_single(TAP::Harness=HASH(0x5608cb0c3e98), TAP::Parser::Aggregator=HASH(0x5608cb6171e0), TAP::Parser::Scheduler=HASH(0x5608cb80a420)) called at /usr/share/perl/5.24/TAP/ line 743
            TAP::Harness::aggregate_tests(TAP::Harness=HASH(0x5608cb0c3e98), TAP::Parser::Aggregator=HASH(0x5608cb6171e0), "t") called at /usr/share/perl/5.24/TAP/ line 558
            TAP::Harness::__ANON__() called at /usr/share/perl/5.24/TAP/ line 571
            TAP::Harness::runtests(TAP::Harness=HASH(0x5608cb0c3e98), "t") called at /usr/share/perl/5.24/App/ line 546
            App::Prove::_runtests(App::Prove=HASH(0x5608cb0b7d48), HASH(0x5608cb526548), "t") called at /usr/share/perl/5.24/App/ line 504
            App::Prove::run(App::Prove=HASH(0x5608cb0b7d48)) called at /usr/bin/prove line 13
    ERROR: Job failed: exit status 1

    From the above I can't even see what error has occurred. Can anyone illuminate me?



Text::Unaccent::PurePerl undef values
1 direct reply — Read more / Contribute
by IB2017
on Mar 18, 2018 at 15:50

    Dear Monks

    I'm sorting an array deaccenting its elements with Text::Unaccent::PurePerl.

    Everything is fine except that my array happens to have now and then some undef elements which apparently is not accepted by Text::Unaccent::PurePerl (Error: unac_string: Input character string is undefined). Any way to turn - on the run - these undef elements let's say, to an empty string ""? My array comes from reading a SQLite database. What would be the approach you suggest?

    @$ResultsFinal =( sort { unac_string($a->[($OptOrderToDisplayTable)]) +cmp unac_string($b->[($OptOrderToDisplayTable)])} @$ResultsFinal );
Hash key composition with a comma?
5 direct replies — Read more / Contribute
by mpersico
on Mar 16, 2018 at 16:09
    Just when I thought I had seen everything:
    my %hash; my $foo = 'hello'; my $bar = 'world'; my $baz = 'folk'; $hash{ $foo, $bar, $baz } = '##eek what magic is this?'; print $hash{"$foo\x{1c}$bar\x{1c}$baz"};
    ##eek what magic is this?

    By what rule are multiple variables, separated by a comma, turned into a string with a File Separator between the pieces? I mean if I squint hard enough, that expression for the key is a list, and then the list is "stringified" to be a key, in which case I would have expected a space (\x{20}) separated expression. Perl 5.16 and Perl 5.26.1

Using Net::SMTP to send pdf attachment
4 direct replies — Read more / Contribute
by Anonymous Monk
on Mar 16, 2018 at 06:25

    Hi monks,

    I'm trying to send pdf files as attachment in emails sent with Net::SMTP. The PDF files reside on my website (like home/mysite/files/PDF_FILES_HERE).

    The code I have below is for sending normal emails:

    use strict; use Net::SMTP; use MIME::Base64; my $smtphost = 'some_smtp_host'; my $username = 'some_username'; my $password = 'some_password'; my $emailto = ''; my $emailfrom = ''; my $subject = 'Hello world'; my $message = 'Test message'; sub date_r { my ($monthday, $mon, $yr, $ time, $hour, $str); my (@lt) = (); @lt = localtime(); $monthday = $lt[3]; $mon = $lt[4]+1; $yr = $lt[5] + 1900; $hour = $lt[2]; $time = sprintf("%02d:%02d:%02d", $hour, $lt[1], $lt[0]); $str = $mon . '/' .$monthday . '/' . $yr . ' ' . $time; return $str; } my $smtp = Net::SMTP->new($smtphost, Debug => 1, Timeout => 5); $smtp->datasend("AUTH LOGIN\n"); $smtp->datasend(encode_base64($username)); $smtp->datasend(encode_base64($password)); $smtp->mail($emailfrom); $smtp->to($emailto); $smtp->data(); $smtp->datasend("MIME-Version: 1.0\n"); $smtp->datasend("From: $emailfrom\n"); $smtp->datasend("To: $emailto\n"); $smtp->datasend("Date: " . date_r() . "\n"); $smtp->datasend("Subject: $subject"); $smtp->datasend("\n\n"); $smtp->datasend($message); $smtp->datasend("\n\n"); $smtp->dataend(); $smtp->quit;

    What do I need to change to make so that I can send attachments (pdf files)?

    Please enlighten me. Thank you in advance.

RegEx : search for 'ax', not followed by 'ba'
1 direct reply — Read more / Contribute
by Anonymous Monk
on Mar 16, 2018 at 05:03

    Hi Monks

    I am looking for a RegEx which search for 'ax', not followed by 'ba' and preplaces this string.

    I have two not fully working solutions:

    1) One with look ahead => Problem: The chars in the look ahead are not replaced => first term in @reg

    2) With two not char sets => Problem: The two charsets are looked speratly, not in combination => second term in @reg.

    Many thanks for any help !!

    Please find here my testbench:

    use strict; use warnings; use Test::More; $\="\n"; # search for 'ax', not followed by 'ba' my @teststr = ('0axba', # simple not ok '1axbb', # one char ok, one not '2axccaxdd', # simple 2 times '1axbaxcc', # one time (sequence combined) '1axcaxcc' # one time (sequence combined) ); my @reg = ( qr/ax(?!ba)/, # look ahead qr/ax[^b][^a]/, # 2 not char sets ); plan tests => @teststr*@reg; for my $re (@reg) { print "---------------\n$re\n---------------"; for my $str (@teststr) { my $str1=$str; my $str2=$str; # get teststring $str1=~s/^\d//; # remove result my $got = $str1=~s/$re/-/g; # replace (do test) $str2=~s/^(\d)//; # remove result and remember cmp_ok($got, '==', $1, "($1) $str2 => $str1 "); #check } }
    Program output =>
    1..10 --------------- (?^:ax(?!ba)) --------------- ok 1 - (0) axba => axba ok 2 - (1) axbb => -bb ok 3 - (2) axccaxdd => -cc-dd ok 4 - (1) axbaxcc => axb-cc not ok 5 - (1) axcaxcc => -c-cc # Failed test '(1) axcaxcc => -c-cc ' # at Y:\atp01082\data\data\Perl\test\ line 30. # got: 2 # expected: 1 --------------- (?^:ax[^b][^a]) --------------- ok 6 - (0) axba => axba not ok 7 - (1) axbb => axbb # Failed test '(1) axbb => axbb ' # at Y:\atp01082\data\data\Perl\test\ line 30. # got: # expected: 1 ok 8 - (2) axccaxdd => -- ok 9 - (1) axbaxcc => axb- ok 10 - (1) axcaxcc => axc- # Looks like you failed 2 tests of 10.
Lexical filehandles: unblessed but (sometimes) can
2 direct replies — Read more / Contribute
by vr
on Mar 15, 2018 at 09:08

    (s/lexical filehandles/references to autovivified anonymous filehandles/ig;)

    There are some (minor) annoying inconsistencies:

    use strict; use warnings; use feature qw/ say /; use Scalar::Util qw/ blessed /; open my $fh, "+>", undef; say $fh-> can( "print" ) ? "yes" : "no"; # no print $fh 123; say $fh-> can( "print" ) ? "yes" : "no"; # no $fh-> print( 123 ); say $fh-> can( "print" ) ? "yes" : "no"; # yes say "no" unless blessed $fh; # no

    In case of "print", indirect & direct method invocations obviously compile differently (+ see below), with different side effects, but:

    use strict; use warnings; use feature qw/ say /; open my $fh, "+>", undef; say $fh-> can( "print" ) ? "yes" : "no"; # no autoflush $fh 1; say $fh-> can( "print" ) ? "yes" : "no"; # yes


    $ perl -MO=Deparse -e ' > open my $fh, "+>", undef; > autoflush $fh 1; > $fh-> autoflush( 1 ); > print $fh 123; > $fh-> print( 123 ); > ' open my $fh, '+>', undef; $fh->autoflush(1); $fh->autoflush(1); print $fh 123; $fh->print(123); -e syntax OK

    It's unclear why lexical filehandle can not do its methods from the start, and for what it was made able "to can" after some magic passes. Why bother with waiting to attach this black magic until later (or at all), and not bless poor things to e.g. IO::Handle class, so that they officially can? Performance/resources issue?

    But, it looks like e.g. autoflushing on one lexical filehandle results to (costly?) black magic turned on all over the program, in different scopes and packages. If so, it somehow reminds of penalties of using $`, $&, $' in previous days.

    use strict; use warnings; use feature qw/ say /; { open my $fh, "+>", undef; say $fh-> can( "print" ) ? "yes" : "no"; # no autoflush $fh 1; say $fh-> can( "print" ) ? "yes" : "no"; # yes } package different; { open my $foo, "+>", undef; open my $bar, "+>", undef; say $foo-> can( "print" ) ? "yes" : "no"; # yes say $bar-> can( "print" ) ? "yes" : "no"; # yes }

    Why do I care? :) Just curious, and also yesterday I was playing with Log::Dispatch::Handle:

    Basically, anything that implements a print() method can be passed the object constructor and it should work.

    So I tried first:

    use strict; use warnings; use Log::Log4perl qw / :easy /; use Log::Dispatch::Handle; open my $fh, "+>", undef; my $app = Log::Log4perl::Appender-> new( "Log::Dispatch::Handle", min_level => "debug", newline => 0, handle => $fh ); __END__ GLOB(0x1ea3a0) is missing the 'print' method

    Using my "secret weapon" autoflush $fh 1; after open:

    Use of uninitialized value $list in concatenation (.) or string at C:/ +berrybrew/5.26.0_64_PDL/perl/vendor/lib/Specio/Constraint/Role/CanTyp line 58. GLOB(0x2d6a3a0) is missing the methods

    How very bizarre. I must admit, with more recent Perl and Log::*** and dependencies installed, the error message makes more sense:

    An unblessed reference (GLOB(0x560dc7cc1348)) will never pass an AnyCa +n check (wants print)

    So, of course I did

    my $fh = IO::File-> new( 'some.log', 'w' );

    and everything works. But, all of the above leaves impression of unclear purposes and behaviour, and possible troubles ahead, for unwary :).

Using Net::SAML2 to do SP-initiated SSO with ADFS
No replies — Read more | Post response
by neilb
on Mar 15, 2018 at 08:19


    Has anyone got experience of doing SAML2-based single sign-on (SSO) using the Net::SAML2 module talking to Microsoft's ADFS as the identity provider?

    I've used Net::SAML2 with other SAML providers, but am struggling with ADFS, and feel like I'm just banging my head against it.

    Cheers, Neil

Which pragmas are activated with a specific perl version?
5 direct replies — Read more / Contribute
by adhrain
on Mar 15, 2018 at 07:04
    Hi noble Monks,

    I can't find anything about this on perldoc and on the net.

    I know that if I use 5.012; I get

    use strict; use warnings;
    but is there somewhere a list that maps $] to its automatically enabled pragmas?

Seeking clarification on possible bug in regex using \G and /gc
2 direct replies — Read more / Contribute
by davido
on Mar 14, 2018 at 18:55

    Consider the following code:

    local $_ = 'foo'; say 'Start' if /\G foo/gcx; say 'Mid' if /\G .*/gcx; say 'End' if /\G \z/gcx;

    The output will be?

    Start Mid

    Change the "Mid" case to this:

    say 'Mid' if /\G .+/gcx;

    And now the output will be:

    Start Mid End

    So all three conditions match. If you use the following quantifiers at the end of the 2nd expression, /z will not match in the third expression:*, ?, {0,}.

    This is confirmed on Perl 5.26, and 5.10.


    perl -E 'local $_ = "foo\n"; say "Start" if /\G foo/gcx; say "Mid" if +/\G .*/gcx; say "End" if /\G (?=\n)/gcx'

    So in this case we added a \n to the string, matched on .* for our "Mid" expression. Then did a lookahead assertion for \n in the "End" expression. Since we are not using the /s modifier, .* should have stopped before \n, so (?=\n) should still find newline (I think), so the "End" condition should be true.

    I'm feeling like the difference between how .+ and .* are consuming the string (/z matching in the 3rd expression when the 2nd expression uses .+, but not matching if .*) is an inconsistency that can't be defended as not being a bug, but I'm interested in what others take on it might be.


Twig delete not deleting the entire section?
4 direct replies — Read more / Contribute
by paisani
on Mar 14, 2018 at 12:19
    use strict; use warnings; use XML::Twig; my $xml = q( <sites> <site siteid="ONE"> <name>name1</name> <address>address1</address> <contact>contact1</contact> </site> <site siteid="TWO"> <name>name2</name> <address>address2</address> <contact>contact2</contact> </site> </sites> ); my %handlers = ( 'name[string() =~ /name2/]' => sub { my ($twig, $cnt) + = @_; $cnt->parent->delete;} ); my $twig= new XML::Twig( PrettyPrint => 'indented', twig_handlers => + \%handlers); $twig->parse($xml); print $twig->sprint;
    Gives me this output -
    <sites> <site siteid="ONE"> <name>name1</name> <address>address1</address> <contact>contact1</contact> </site> <address>address2</address> <contact>contact2</contact> </sites>
    What am I missing?? I wanted to delete the entire section for siteid=TWO.
New Meditations
Converting everything (MySql, perl, CGI, website) to UTF-8
1 direct reply — Read more / Contribute
by jfrm
on Mar 16, 2018 at 04:01

    In order to deal with Japanese orders, I recently had to convert my whole system to UTF-8. A day or 2's job I thought. 2.5 weeks later, I'm finally there. There is a lot of stuff on Perlmonks and the internet in general about this but it is hard to understand and even harder to implement. Most of the advice I read was along the lines of RTFM or did not give the whole story. It's pretty clear this is a common problem, too. I wanted to give something back to the community as perlmonks has helped me a lot, so I thought I would share some insights that I hope will be practical and useful.

    There is a lot out there telling you to used decode/encode and giving lectures on internal representation of UTF8 in Perl and wotnot. In the end I've only had to use decode in one place where data is coming in from elsewhere. If you get all the other stuff right, I believe you shouldn't need any or many instances of decode/encode.

    Our system involves a local website using MySQL, a live website, static webpages, generated webpages, various text files and CGI website forms. All of this needs work to make it work. Here are the things that I needed to do:

    Checklist of changes to make

    * Firstly, every script file is converted to UTF-8 format. Easy.

    * Every script to have this at the top: use utf8; This tells perl that the script itself is in UTF format. So a in the script will be interpreted as a UTF-8 . It's no good just putting this in the calling script as it only seems to extend for the scope of the script underneath; not any other scripts that are imported with require...

    * Ideally each database table must be turned to UTF-8 format. This turns out to be difficult and time-consuming because any tables with foreign keys won't convert unless you first delete the foreign keys. For those that won't easily convert, you can convert only the fields that might hold UTF-8 encoded characters to UTF-8 format. Also BLOB fields are a problem unless the whole table is UTF-8. I had to convert problem BLOB fields to TEXT fields and then convert them to UTF-8 format (a 2 step process, doing both in 1 step fails).

    * Rose::DB (or whatever database method you are using) needs to be told that incoming data from the Database is in UTF-8. For Rose:DB, add this to the connector in and then regenerate connect_options => {mysql_enable_utf8 => 1}

    * binmode(STDOUT, ":utf8"); # Put this at the top of a script - tells it to output UTF to stdout. Not sure if this is just needed only once in the opening script or in any requires, too?

    * Webpages must have this in the head section: <meta http-equiv="content-type" content="text/html; charset=UTF-8">

    * use CGI qw(-utf8); to treat incoming CGI parameters as UTF-8. Getting this working was subtle - test carefully.

    * When outputting a CGI webpage, the first thing to do is to output the http header and this needs to be told about UTF8 too: Personally I found that print header(-type=>'text/html', -cookie=>'', -charset=>'utf-8'); gave problems with cookies so ended up outputting it direct: print "Content-type: text/html; charset=utf-8\n$cookie\n\n";

    * use open ':encoding(utf8)'; # tells it to deal with all files in a UTF8 way. In fact, I was more careful with this and did not use it in general. Instead, I have specifically opened each file that needed it with open($fh, '<:encoding(UTF-8)', $filename);. Because some files that I have to deal with have not been given to me in UTF-8 format. Careful - this can fail if the $filename variable is not also in UTF8!

    Identifying Errors

    In doing this, you will make mistakes and see weird characters appearing in unexpected places. I developed my own personal understanding of how to deal with them. These are my own notes for practical situations so please bear with me, if the explanations are not exactly correct - it was about fixing stuff not being a perl rocket scientist.

    • You see displayed as '£'
      • If sign is coming from dbase and is stored correctly in dbase and webpage is correctly displaying UTF-8 characters from elsewhere (e.g. write japanese text into the perl script and print it), then the UTF-8 is not being retrieved from the database as UTF-8 (presumably being assumed to be Latin1).
      • The is within a UTF-8 encoded PERL script but use utf8; is not set at the top of the script.
      • The is displayed correctly in a form initially but when the form is saved/updated, the then displays as '£'. Use the -utf8 CGI pragma to treat incoming parameters as UTF-8: use CGI ('-utf8');
    • is displayed on a webpage as �
      • This happens when the http header Content Type is not UTF8 and the meta tag is similarly <meta http-equiv="Content-Type" content="text/html" />
    • or other characters are being displayed as a diamond with ? inside it
      • StackOverflow:...usually the sign of an invalid (non-UTF-8) character showing up in an output (like a page) that has been declared to be UTF-8. Can be fixed by putting the following at the top of script: binmode(STDOUT, ":utf8");
    • Error message: Wide character in print
      • Means a print statement (to STDOUT or a file) that is outputting Latin1 includes a UTF-8 character... To fix, add '>:encoding (UTF-8) to the open statement or #binmode(STDOUT, ":utf8");
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 making s'mores by the fire in the courtyard of the Monastery: (10)
As of 2018-03-20 16:06 GMT
Find Nodes?
    Voting Booth?
    When I think of a mole I think of:

    Results (254 votes). Check out past polls.