Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot

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
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.
UTF-8 Email Form
4 direct replies — Read more / Contribute
by oswulf
on Mar 14, 2018 at 05:09

    Does anyone know of a ready-to-use script to back a contact form on a website that will send an Email via SMTP and which supports UTF-8?

    NMA FormMail would appear to do this (it has a UTF-8 configuration setting and some associated code) but it simply doesn't work. Foreign language text arrives as gibberish. (And I'm not the only person to report this.)

    I'd prefer not to have to write something myself given all the security considerations.


Pod does not render correct by verbose 2
2 direct replies — Read more / Contribute
by raiserle
on Mar 13, 2018 at 16:36
    Hi, i've copy this code from Perlmonks.
    #! /usr/bin/perl #use strict; #use warnings; use Getopt::Long; use Pod::Usage; &GetOptions( 'h|help' => \$opt_help, 'man' => sub{ pod2usage({-verbose=>2, -exitval=>0}); }, 'q|quiet' => \$opt_quiet, 'c|config=s' => \@opt_config, 'p|project=s' => \$opt_proj ) || pod2usage(1); if($opt_help){ print "help---------------\n"; pod2usage(1); } __END__ =head1 NAME - Test for =head1 SYNOPSIS [options] Options: -h, --help brief help message --man full documentation =cut
    ./ -h
    this is displayed:
    help--------------- Usage: [options] Options: -h, --help brief help message --man full documentation
    But, the verbose 2 is not working,
    ./ -m
    this is displayed:
    #! /usr/bin/perl #use strict; #use warnings; use Getopt::Long; use Pod::Usage; &GetOptions( 'h|help' => \$opt_help, 'man' => sub{ pod2usage({-verbose=>2, -exitval=>0}); }, 'q|quiet' => \$opt_quiet, 'c|config=s' => \@opt_config, 'p|project=s' => \$opt_proj ) || pod2usage(1); if($opt_help){ print "help---------------\n"; pod2usage(1); } __END__ =head1 NAME - Test for =head1 SYNOPSIS [options] Options: -h, --help brief help message --man full documentation =cut ./ (END)
    The complete source is shown. What do I have to do to correct the error? regards Henrik
LWP::UserAgent : setting max_redirect to 0 yields 'Client-Warning: Redirect loop detected
4 direct replies — Read more / Contribute
by bliako
on Mar 13, 2018 at 14:38

    Sisters and Brothers,

    I am trying to tell LWP::UserAgent (UA) not to follow any redirect (for example, a server response of '302 Found').

    I would like UA to simply make a request and then just to return the HTTP::Response back to me.

    So, I create UA as thus:

    my $ua = LWP::UserAgent->new( 'requests_redirectable' => [], 'max_redirect' => 0, );

    With the above, I can see in my logs that indeed UA does not follow the redirect but now I get a warning:

    Client-Warning: Redirect loop detected (max_redirect = 0)

    which is produced in this check in (sub request):

    if ($response->redirects >= $self->{max_redirect}) { $response->header("Client-Warning" => "Redirect loop detected (max_redirect = $self->{max_re +direct})" ); return $response; }

    The redirect count is zero, the max_redirects is zero but that does not mean a redirect loop has been detected.

    Or am I confused (just in this particular issue)?



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 perusing the Monastery: (8)
As of 2018-03-19 00:02 GMT
Find Nodes?
    Voting Booth?
    When I think of a mole I think of:

    Results (231 votes). Check out past polls.