Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

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.

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.

Post a new question!

User Questions
conditional catch-blocks 'try {} catch(COND) { }'
2 direct replies — Read more / Contribute
by LanX
on Sep 19, 2021 at 16:30
    Hi

    this is part of a longer meditation, but I want to keep it short:

    I want to be able to catch error-objects thrown with die and I want to have an easy syntax:

    the JS model is reproducible 1-to-1 with Try::Tiny it's even easier because Perl's $_ is automatically set to JS's e

    from try...catch#conditional_catch-blocks

    try { myroutine(); // may throw three types of exceptions } catch (e) { if (e instanceof TypeError) { // statements to handle TypeError exceptions } else if (e instanceof RangeError) { // statements to handle RangeError exceptions } else if (e instanceof EvalError) { // statements to handle EvalError exceptions } else { // statements to handle any unspecified exceptions logMyErrors(e); // pass exception object to error handler } }

    But in most cases the final else will just do die $_ to propagate the error to higher call levels, hence it's boilerplate.

    Python has a model for this by providing a condition after the 'catch', if non is matched the error is raised again.

    from https://pythonbasics.org/try-except/

    try: # your code here except FileNotFoundError: # handle exception except IsADirectoryError: # handle exception except: # * # all other types of exceptions print('Should reach here')

    (* the last except must be removed to automatically raise the error again)

    So ideally one could define in Perl a prototype for catch (COND) { CODE } where the (COND) part is optional. Alas that's not possible in Perl, even with mandatory (COND) (otherwise experiments with syntax extension were easy)

    Three workarounds come into mind

    1. a bail out function only {} (or maybe handle {} )

    try { # your code here } catch { only { FileNotFoundError }; # # handle exception } catch { only { IsADirectoryError }; # handle exception } catch { # * # all other types of exceptions }; print('Should reach here')

    (* again, if the simple catch is removed the error is automatically thrown again die $_ )

    ( the COND is either a boolean expression or a constant resp. object representing an error-class. Since an error-class is blessed into a type like "ErrorClass" this can be tested by only ... hence a shorthand for $_->isa(FileNotFoundError) ... not sure if Python has the same flexibility ;)

    2. extend catch (&;&) {...} with optional second sub {}

    try { # your code here } catch { FileNotFoundError } sub { # handle exception } catch { IsADirectoryError } sub { # handle exception } catch { # * # all other types of exceptions }; print('Should reach here')

    3. as a variant of 2. use an "underscore" sub _ as syntactic sugar to chain code-blocks

    with sub _ (&;@){ return @_ }

    try { # your code here } catch { FileNotFoundError }_ { # handle exception } catch { IsADirectoryError }_ { # handle exception } catch { # * # all other types of exceptions }; print('Should reach here')

    This variant could help implementing a future built-in syntax catch () {} by parsing {...}_ as (...)

    Like that module authors wanting to be backwards compatible to older versions could keep writing {...}_ without loosing the full performance of newer versions.

    And new syntax for compound statements could be experimentally implemented and tested.

    finally

    I wanted to keep it short and didn't show much implementation detail. I'm more interested in comments regarding the interface... or probably I'm missing a good CPAN module already?

    comments? suggestions?

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

why is $1 cleared at end of an inline sub?
3 direct replies — Read more / Contribute
by perl-diddler
on Sep 16, 2021 at 08:26
    Have a quick question, the answer for which seems to be obvious, but just wanting to check and maybe hope I'm wrong.

    #!/usr/bin/perl use strict; use warnings; use P; my $intxt; $intxt = << 'TXT' ; <package type="rpm"> <name>7kaa-music</name> <url>http://7kfans.com/</url> TXT ; sub REindex($$;$) { #like 'index', except substr is RE my ($str,$ss)=(shift, shift); my $p = @_ ? shift:0; $str =~ m{^.{$p,$p}($ss+)} ? length $1 : -1; } my @lines=split "\n", $intxt; my $ln; my $lineno=0; sub getln() { return $lineno<@lines ? $lines[$lineno++] : undef; } my $ttag; sub getnxt_tagln(); local * getnxt_tagln; *getnxt_tagln = sub () { do { $_=getln(); defined $_ or return undef; } until m{^\s*<(/?\w+)}; $ttag=$1; }; my $tag; NXTPKG: while (getnxt_tagln()) { # why '$1' null? $ln = $_; $tag = $1; Pe "_=%s, ttag=%s, tag=%s", $_, $ttag, $tag; } # vim: ts=2 sw=2 ai number
    My question concerns the comment after the NXTPKG line: why '$1' null (∄)?

    When I run this:

    _=<package type="rpm">, ttag=package, tag=∄;
    _=  <name>7kaa-music</name>, ttag=name, tag=∄;
    _=  <url>http://7kfans.com/</url>, ttag=url, tag=∄;
    

    tag is null/undef when I get out of my inline-sub. I can get around it by assigning $1 to $ttag, but I don't have any other Regex's that should be clearing '$1'. Seems a bit weird to have the end of a local sub clear '$1', yet that seems to be what is happening. Why? What was the logic of forcing/doing that?

    tnx!

creating the hierarchy pattern from the input file
3 direct replies — Read more / Contribute
by pruthvik
on Sep 16, 2021 at 04:01

    HI Monks,

    I'm trying to create the hierarchy pattern from the input below

    Input:

    + instreg@d1@d1 instreg@d1@d2 instreg@d2@d1 instreg@d3@d1 instreg@d4@d1 instreg@d5@d1 instreg@d6@d1 instreg@d7@d1 instreg@d8@d1 alureg@d1@d1 alureg@d2@d1 alureg@d3@d1 alureg@d4@d1 alureg@d5@d1 alureg@d6@d1 alureg@d7@d1 alureg@d8@d1 pgmctr@d1@d1 pgmctr@d2@d1 pgmctr@d3@d1 pgmctr@d4@d1 pgmctr@d5@d1 pgmctr@m1 pgmctr@m2 pgmctr@m3 pgmctr@m4 pgmctr@m5

    output:

    instreg { d1 { d1,d2 } d2 { d1 } .... ,,, d8 { d1 } } alureg { d1 { d1 } d2 }
Error while installing Perl module GD-2.73.
3 direct replies — Read more / Contribute
by Anonymous Monk
on Sep 15, 2021 at 14:16

    Hi Monks,

    I am getting below error while installing Perl module GD-2.73.

    "Can't open perl script "Build": No such file or directory"

    Could you please provide inputs on how to resolve this issue
    Note that i am not installing it manually but from the script.

    Thank you.

Troubleshooting PDF::API2 overlaying text on an existing PDF
3 direct replies — Read more / Contribute
by trillich
on Sep 15, 2021 at 11:51

    Having trouble diagnosing an issue with PDF::API2, where I have an existing PDF to bring in as a background/watermark/letterhead, and then I programmatically overlay text on top of that.

    This is the code that brings in the background, before any text is overlaid on top:

    my $xo = $pdf->importPageIntoForm( $bg_pdf, 1 ); my $gfx = $page->gfx(); $gfx->formimage( $xo, 0, 0, 1.0 );

    This code runs fine, no errors -- and the $bg_pdf is a simple PDF v1.4 saved straight from Adobe Illustrator. But after some text is added by the script, the output is partially corrupted. That is, the imported letterhead PDF shows up to a point and then the rest is skipped/ignored until the overlaid text displays. For example, the letterhead includes several rectangles, and only a scant few show up in the generated PDF.

    So it appears that upon display, the data for the existing background-pdf gets corrupted somehow, but the programmatic text overlaid on top, is just fine.

    Early on I learned to turn off $pdf->{forcecompress} = 0; to keep the whole resulting PDF from being weirdly and randomly scrambled. So that shouldn't be pertinent here.

    I've tried exporting the Illustrator PDF output in a number of different formats (v1.3, 1.4, 1.5); with or without 'preserve illustrator editing capabilities'; compression turned on or off; with including embedded fonts like garamond, vs using helvetica only, vs converting all text to outlines...

    How does one go about troubleshooting this? Using PDF::API2 v2.038, in perl 5.30.0

print in CMD window
5 direct replies — Read more / Contribute
by BillKSmith
on Sep 14, 2021 at 15:45
    I have written the first draft of a module which adds an encoding layer to STDOUT so non-ascii characters print correctly in a CMD window (under Windows 7) Consider the following one-liner in a CMD window.
    perl -e"print qq(\xe4)"

    It incorrectly displalys a greek sigma.

    Now with my module

    perl -MDOS::Try -e"print qq(\xe4)"

    It now displays the correct character

    So far so good! Now I want to automate this test. I thought that I could run this script in backtics and capture the STDOUT.

    use strict; use warnings; use $result; $result = `perl -MDOS::Try -e"print qq(\xe4)"`; print $result;

    This script displays the greek sigma. The module does not work in this environment.

    I need help finding either a better way to test this module or a way to rewrite it which avoids the problem. The 'guts' of the module (below) consists of three statements cut and pasted from exampmles in the documentation of open (with minor edits as necessary)

    package DOS::Try; use strict; use warnings; open(my $oldout, ">&STDOUT") or die "Can't dup STDOUT: $!"; close STDOUT; open(STDOUT, ">&:encoding(Cp437)", $oldout) or die "Can't dup \$oldout +: $!"; 1
    Bill
Getting duplicate file contents in perl
2 direct replies — Read more / Contribute
by noviceuser
on Sep 13, 2021 at 08:32

    i am trying to read contents of all the file present in a folder and store/append all the file contents in a single text file, but i can see data getting repeated of same file in the output text file such as

    suppose there are 3 files (1.txt, 2.txt, 3.txt) in the folder then the output file contains data from these files as below, i.e data of 1.txt gets repeated 3 times and data of 2.txt twice

    <code> 1.txt 1.txt 2.txt 1.txt 2.txt 3.txt
Tk autosizing Scrolled widgets
3 direct replies — Read more / Contribute
by olgo
on Sep 13, 2021 at 05:28

    Greetings! Is there a way of getting a Tk Scrolled (Subwidget) Pane to automatically resize up to a limit (typically screen limitations)? It seems the dimensions of the Tk Scrolled widget needs to be specified explicitly, either when defining the widget or later using -configure(). I would want my main window and all contained widgets to expand with my dynamically defined Scrolled widget contents, and the scrollbars appear only when there is no place left to expand. Using Strawberry 5.32 on a Win32 system.

    use Tk; use Tk::HList; use Tk::Pane; use strict; my $Window = MainWindow->new(); $Window->geometry("+0+0"); $Window->maxsize(1000,1200); $Window->minsize(400,300); my $tab = $Window; my $scroll = $tab->Scrolled('Pane', -sticky => 'news', -scrollbars => 'osoe', ); $scroll->pack; my $pane = $scroll->Subwidget("scrolled"); my $grid = $pane->HList( -columns => 13, -width => 0, # Causes scrollbar to appear -height => 0 # Causes scrollbar to appear ); $grid->pack(); $scroll->pack(-expand => 1, -fill => 'both'); foreach my $row (0..10) { $grid->addchild(""); foreach my $col (0..12) { my $wid = $grid->Entry( -text => "Whatever", -width => 0, ); $wid->pack; $grid->itemCreate ($row, $col, -itemtype => 'window', -widget => $wid); } } #$pane->configure(-height => '1000', -width => '1000'); # Works, but s +hould be handled by pack MainLoop;
Need to get the key information from key and value pair
4 direct replies — Read more / Contribute
by chandantul
on Sep 13, 2021 at 02:39

    Hello Perl monks, I have below json data and i would like to print only preview_sandbox_1_link in my excel field. I would like to inform that i will have 1000 entries with different applinks key information.

    [ { "visio": { "Launch": false, "hide": { "iOS": true, }, "appLinks": { "preview_sandbox_1_link": true } }, } ]

    I have iterate above json data by below code and was able to to capture following "preview_sandbox_1_link": true but unable to print the key "preview_sandbox_1_link" Please check my below code let me know the reason i was not able to print the key value.

    use strict; use warnings; use Win32::Process; use REST::Client; use JSON::Parse ':all'; use MIME::Base64; use Term::ReadKey; use Data::Dumper; use MIME::Lite; use Net::SMTP; use Spreadsheet::XLSX; use Spreadsheet::ParseXLSX; for my $i (0..$#responsetextall) { for my $j (0..$#{$responsetextall[$i]}) { $responseapplinks = $responsetextall[$i][$j]{visio{appLi +nks}}; $worksheet->write(0, 1, 'Visio-appLinks' , $my_format); $worksheet->write($r, 15, $responsetextall[$i][$j]{visio}{a +ppLinks}); } }
Can unpack add zero bytes before converting?
4 direct replies — Read more / Contribute
by mossi2000
on Sep 12, 2021 at 09:29
    Hi monks,

    I'm using Perl to parse the byte stream output of a hardware.
    Depending on the HW configuration I get a stream of data consisting
    of 40, 48, 56 or 64 bits litle-endian.
    In principle the lower 5,6,7 or the complete 8 byte of a 64bit litle-endian integer.
    I was trying to convert this data using unpack but whatever I tried using 'x' or '@'
    I did not succeed in (p)adding the missing 0 bytes before converting to a 64bit integer.
    (I'm using a Perl with support for 64bit integers)

    My current solution looks like: (using bitstrings..)
    my $bytes_per_value = 5; # to simulate the byte stream using 40bit = 5 * 8bit; my $value = 0xf_dead_beef_4; my $bin_value = substr (pack ('Q', $value), 0, $bytes_per_value); my $buffer = $bin_value x 4 my $nbytes = length ($buffer); my $fmt = sprintf "(b%d)*", $bytes_per_value << 3; my @stream_data = unpack ($fmt, substr ($buffer, 0, $nbytes)); my @values = map { oct '0b'.reverse ($_)} @stream_data; foreach my $v (@values) { printf "0x%x\n", $v; }

    My question:
    Is there a way to unpack this stream directly into an array of QWords (64bit)
    using some form of unpack for 5,6 and 7 byte data. (The 8 byte case is obviously easy :-) )

    Means: Can I specify via the format string to convert 5,6 or 7 bytes + 3,2 or 1 padding Zero bytes
    to a 64bit integer?
    Or can unpack only work on "existing" data bytes.

    Thanks for any hints!

    Axel

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


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (3)
As of 2021-09-20 11:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?