Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
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
pack on unpack with same template
3 direct replies — Read more / Contribute
by jjmoka
on Jul 27, 2021 at 18:33
    I've found this code
    $$xmlScalar_r = pack('U0C*', unpack('U0C*', SGMLencode_data($$xmlScalar_r)||(defined($$xmlScalar_r) ? $$xmlScalar_r : '') ));
    
    regardless of everything in the end, it is then just something like:
    $string = ... $x = pack('U0C*', unpack('U0C*', $string));
    I see nothing different which cannot be done as just
    $x = $string #or without even $string, just $x = ...
    so it would seem a useless usage of pack and unpack being the template the same.

    Are there special cases of any sort (e.g. different environments, architectures)
    where the pack/unpack achieve anything different ?
    Thanks
Dealing with nextline of a file
5 direct replies — Read more / Contribute
by jnarayan81
on Jul 27, 2021 at 04:37

    When I tried to read nextline, the pointer in the while loop reads two lines at a time. Is there another creative way to deal with the file's next line?

    use strict; use warnings; my %store; my $nextline; my $cnt=1; my $filename = "$ARGV[0]"; open(my $fh, '<:encoding(UTF-8)', $filename) or die "Could not open fi +le '$filename' $!"; while (my $row = <$fh>) { chomp $row; my @tmp = split /\s+/, $row; $nextline = <$fh>; chomp $nextline; my @nexttmp = split /\s+/, $nextline; print "$row\t$cnt\n"; if ($tmp[0] ne $nexttmp[0]) { $cnt++; } print "$nextline\t$cnt\n"; } close $filename;
Dancer + template toolkit default html filter
1 direct reply — Read more / Contribute
by AlexP
on Jul 25, 2021 at 14:13

    Hi monks! Today I started studying Dancer with this tutorial and maybe I'm getting ahead but I wonder is there a way to apply default html filter to all variables?

    So far I've only seen an example with explicit syntax like:

    [% entries.$id.text | html %]

    However, it seems to me that this approach may lead to the fact that developer may forget to apply the filter and xss will occurs.

    Searching for this topic led me to node and to Template::AutoFilter but it was in early 2011.
    Should i use this approach today or there are modern ways to achieve this? And can I use this with dancer?

Generate a thumbnail for a given link
2 direct replies — Read more / Contribute
by Matthew.S
on Jul 25, 2021 at 10:31
    Hello Perl Monks. I'm looking to write a Perl utility that will accept a link to some web page/resource and will generate a thumbnail for that web page (assuming that the given web page/resource supports it). When saying "thumbnail" I expect to generate something like say WhatsApp generates when You paste a link into it (a picture with some short text title and a link). The desired output from the utility could be an image file and a textual title in a text file that I can later use to my needs. What general approach would You suggest for me to take? Thank You for Your wisdom.
file modifications using file::find
4 direct replies — Read more / Contribute
by propellerhat
on Jul 24, 2021 at 21:59
    After much searching and reading, the articles I have have found regarding File::Find do nothing other than list file names, though they begin by saying things such as "do something with file". I need help or a tutorial which shows me how to: (1) run an IF check on files located by File::Find (2) read from and write to a file which passes the IF check I suppose File::Find returns whatever I need to open a filehandle, but I have not located the File::Find specification.
perl built with -DDEBUGGING causes "failed to extend arg stack" error with XS modules
2 direct replies — Read more / Contribute
by parv
on Jul 24, 2021 at 17:44

    I recently built perl 5.32.1 with -DDEBUGGING & DateTime 1.54 from source (Ports, FreeBSD 13-STABLE). Now use of DateTime results in "failed to extend arg stack" (a solution seems not likely any time soon, tagged as "low serverity) ...

    # perl -MDateTime -e0 panic: XSUB Package::Stash::XS::list_all_symbols (XS.c) failed to exte +nd arg stack: base=801cff418, sp=801cff480, hwm=801cff440 Compilation failed in require at /usr/local/lib/perl5/site_perl/mach/5 +.32/DateTime/Duration.pm line 12. BEGIN failed--compilation aborted at /usr/local/lib/perl5/site_perl/ma +ch/5.32/DateTime/Duration.pm line 12. Compilation failed in require at /usr/local/lib/perl5/site_perl/mach/5 +.32/DateTime.pm line 14. BEGIN failed--compilation aborted at /usr/local/lib/perl5/site_perl/ma +ch/5.32/DateTime.pm line 14. Compilation failed in require. BEGIN failed--compilation aborted.

    What good is -DDEBUGGING now if it XS modules cannot run.

    Is there a way to have perl built with DEBUGGING and XS modules not fail?

Inline::C : passing parameters to functions, modifying by reference
5 direct replies — Read more / Contribute
by bliako
on Jul 22, 2021 at 19:54

    Dear Monks,

    I have spent quite some time in trying to do a seemingly simple task with Inline::C, that of passing a reference to a function and the function modifying it so that caller gets results back. I don't want to use the return() mechanism, so my function looks like int func(SV *inp, SV *out); inp is a readonly ref and out is the ref I would like to write to.

    I have 3 cases I would like to deal with:

    1. out is an arrayref, e.g. my @inp; my @out; func(\@inp, \@out); In this case I want to remove all elements of @out if any and then make it a 2D array of 5cols and 3rows, containing the number 42.

    2. out is a scalar, e.g. my @inp; my $out; func(\@inp, $out); In this case I want to make $out an arrayref and proceed to fill it as above, so that caller can dereference as my @out = @$out.

    3. out is a scalarref, e.g. my @inp; my $out; func(\@inp, \$out); In this case I want to find if its dereference, e.g. $out is a ref to any array or hash, or just a plain scalar. If it's a plain scalar I would like to make it an arrayref and proceed as above, so that caller can dereference as my @out = @$out.

    Can anyone help me to fill any of the blanks in this advent calendar of perlguts?

    Here is a test script testing each case.

    use strict; use warnings; use Test::More; use Inline C => Config => BUILD_NOISY => 1, clean_after_build => 0, warnings => 10, ; use Inline C => <<'EOC'; #include <stdio.h> // checks if array is indeed an arrayref and sets array_sz to its size + and // returns 1 else returns 0 (not an array) int is_array_ref( SV *array, size_t *array_sz ){ if( ! SvROK(array) ){ fprintf(stderr, "is_array_ref() : warning, i +nput '%p' is not a reference.\n", array); return 0; } if( SvTYPE(SvRV(array)) != SVt_PVAV ){ fprintf(stderr, "is_array_r +ef() : warning, input ref '%p' is not an ARRAY reference.\n", array); + return 0; } // it's an array, cast it to AV to get its len via av_len(); // yes, av_len needs to be bumped up, it's $#array int asz = 1+av_len((AV *)SvRV(array)); if( asz < 0 ){ fprintf(stderr, "is_array_ref() : error, input arra +y ref '%p' has negative size!\n", array); return 0; } *array_sz = (size_t )asz; return 1; // success, it is an array and size returned by ref, abo +ve } int func( SV *inp, SV *out ){ AV *av, *av2; size_t i, j, asz; if( is_array_ref(out, &asz) ){ printf("Case1: @out\n"); // we have an \@R, e.g. func(\@R) av = (AV *)SvRV(out); // but first clear any contents if( asz > 0 ) av_clear(av); } else if( SvROK(out) ){ printf("Case3: \\$out\n"); // we have a scalar ref, e.g. func(\$x) av = newAV(); sv_setsv(SvRV(out), (SV *)av); } else { printf("Case2: $out\n"); // we have a scalar e.g func($x); av = newAV(); sv_setsv(out, (SV *)av); } // and fill it in for(i=0;i<5;i++){ av2 = newAV(); av_extend(av2, 3); av_push(av, (SV *)av2); for(j=0;j<3;j++){ av_store(av2, j, newSViv(42)); } } return 0; // success } EOC my @inp = (1..5); my @out; my $T = 'Case1'; is(func(\@inp, \@out),0, "$T: called success."); is(scalar(@out), 5, "$T: rows are 5"); for(my $i=0;$i<5;$i++){ ok(ref($out[$i])eq'ARRAY', "$T : item $i is ARRAYref."); is(scalar($out[$i]), 3, "$T : it has 3 elements."); for(my $j=0;$j<3;$j++){ is($out[$i]->[$j], 42, "$T : it's value is 42."); } } $T = 'Case2'; my $out; is(func(\@inp, $out),0, "$T: called success."); is(ref($out)eq'ARRAY', "$T: it is now an ARRAYref."); @out = @$out; is(scalar(@out), 5, "$T: rows are 5"); for(my $i=0;$i<5;$i++){ ok(ref($out[$i])eq'ARRAY', "$T : item $i is ARRAYref."); is(scalar($out[$i]), 3, "$T : it has 3 elements."); for(my $j=0;$j<3;$j++){ is($out[$i]->[$j], 42, "$T : it's value is 42."); } } $T = 'Case3'; $out = undef; is(func(\@inp, \$out),0, "$T: called success."); is(ref($out)eq'ARRAY', "$T: it is now an ARRAYref."); @out = @$out; is(scalar(@out), 5, "$T: rows are 5"); for(my $i=0;$i<5;$i++){ ok(ref($out[$i])eq'ARRAY', "$T : item $i is ARRAYref."); is(scalar($out[$i]), 3, "$T : it has 3 elements."); for(my $j=0;$j<3;$j++){ is($out[$i]->[$j], 42, "$T : it's value is 42."); } } done_testing();

    thanks in advance, bw, bliako

How Perl decides where a variable ends and text starts: Match variables in string interpolation
1 direct reply — Read more / Contribute
by davido
on Jul 22, 2021 at 18:14

    Once in awhile Perl still surprises me.

    This code is obviously broken:

    my ($left, $right) = qw(abc def); print "$left_$right\n";

    The problem is that interpolation causes Perl to want to print a variable $left_ and $right, but we declared $left and $right. There are several ways to fix this, two of which are:

    print "$left\_$right\n"; print "${left}$right\n";

    ...and of course you could just use the concatenation operator, but then I wouldn't have anything to puzzle over.

    But observe the following:

    my $string = "abcd"; if ($string =~ m/(ab)(cd)/) { print "$1_$2\n"; }

    The output is ab_cd. So in this case Perl automatically treated that interpolation as "${1}_$2\n" without me telling it to do so. I've looked over The Gory details of parsing quoted constructs and haven't found an explanation. I assume that in the case of numbered regex variables, Perl decides that if the variable starts with a numeric digit, the identifier must end when there are no more numeric digits. Is this behavior reliable? Is it documented? Is it likely to ever change?

    I'm asking because I found it in a code review and was sure it was broken until we talked it over and tested to verify the behavior was to parse "$1_$2\n" as $1 . '_' . $2 . "\n" even though we would prefer to disambiguate using \ or ${n}.

    Update: I do see in perldata: Identifier-parsing:

    Meanwhile, special identifiers don't follow the above rules; For the most part, all of the identifiers in this category have a special meaning given by Perl. Because they have special parsing rules, these generally can't be fully-qualified. They come in six forms (but don't use forms 5 and 6):

    1. A sigil, followed solely by digits matching \p{POSIX_Digit}, like $0, $1, or $10000.

    I don't know that this is worded quite right, because $1_ could be construed as NOT being an identifier consisting solely of digits. But it's the closest thing I can find to an explanation. But I'll take that as answering my own question: Yes, it's intentional and documented behavior.


    Dave

Question regarding a regex
7 direct replies — Read more / Contribute
by CrashBlossom
on Jul 22, 2021 at 14:34
    Hello Monks,
    I would like some help in understanding the regular expression in the following code:
    sub TextFile { return 0 if (! -f $_[0]); return 0 if (! -r $_[0]); open FH, "<" . $_[0]; my $block = " " x 4096; my $bytesread = sysread FH, $block, 4096; close FH; if (! defined $bytesread) { print "*** ERROR: TextFile: $_[0]: $!\n"; return 0; } return $block =~ /^[\r\n\t -~]*$/s; }
    It attempts to guess whether a file is a text file based on what it sees in the first 4096 characters. I ran across it while seeking an alternative to -T to check for a text file. It seems to work in my tests, but I don't understand why because I don't understand what the regex is matching.

    My understanding is that [] defines a character class. A ^ before [] means negation. * means zero or more. $ means end of line. So if I put that all together, it seems to mean that
    $block =~ /^[\r\n\t -~]*$/s
    is true if $block does nor include any of \r\n\t -~ before an end of line. But that doesn't make sense. I'm also mystified by the inclusion of the characters -~ in the character class.

    Can anyone unpack all this for me?

    I am running strawberry perl 5.30 on windows 10.

    Thanks!
Bugfixing Old Code
2 direct replies — Read more / Contribute
by cluelessPerlMan
on Jul 22, 2021 at 11:27

    Dear Monks, I apologize I am completely clueless with Perl and as a favor have opted to help fix an old simulation model. The developer preceding me decided to use Perl to parse some data files, and for some reason it is no longer compiling and throwing errors. I am in the process of teaching myself Perl but any advice would be greatly appreciated. The errors being thrown: Experimental push on scalar is now forbidden at ../../plot_TTTDIA.pl line 44, near "@header)" Experimental push on scalar is now forbidden at ../../plot_TTTDIA.pl line 69, near "@twenty_SFs)" Execution of ../../plot_TTTDIA.pl aborted due to compilation errors.

    #!/usr/bin/perl use CGI::Carp qw(fatalsToBrowser); use strict; use warnings; use feature 'say'; use List::Util 'max'; ## If the @left curve passes through the @right curve, ## replace the values that pass with 'nan'. sub trim_curves { my @left = @{shift @_}; # array of references my @right = @{shift @_}; my $rows = shift @_; # integer my $y = $rows - 1; # Start reading from the tail of the data first. for (my $i = $y; $i >= 1; $i--) { # $i = 0 is the header if (${$left[$i]} > ${$right[$y]}) { ${$left[$i]} = 'nan'; $y--; } else { # If @left is no longer greater, stop. last; } } return; } ## Grab useful information from the $infile and put it ## into a column-oriented, tab-separated format. sub parse_file { my $infile = shift @_; my $outfile = shift @_; open (my $in, '<', $infile) || die "Can't open $infile: $!"; open (my $out, '>', $outfile) || die "Can't open $outfile: $!"; # Build TTTPLOT data my @TTTPLOT; # 2D array my @header = ('Temperature', 'StartFerrite', 'StartPeralite', 'Sta +rtBainite', 'MaxSF'); for (my $i = 1; $i <= 20; $i++) { push @header, "SF($i)"; } push /@TTTPLOT, /@header; # Current row index of @TTTPLOT my $index = 1; # Index of 0 is the header above # Read the file's header data my $grade = <$in>; my $chemcomp = <$in>; my $grain = <$in>; my $asymptotes = <$in>; # Read the file's per-temperature data while(<$in>) { # Split on multiple spaces using regex captured matches my @temp_and_starts = $_ =~ /[^\s +]+/g; my @last_AT_fracs = <$in> =~ /[^\s +]+/g; my @twenty_SFs = (<$in> . <$in> . <$in> . <$in>) =~ /[^\s +]+/g; my $max_SF = max @twenty_SFs; # Build the @TTTPLOT row $TTTPLOT[$index]->[0] = $temp_and_starts[0]; $TTTPLOT[$index]->[1] = $temp_and_starts[1]; $TTTPLOT[$index]->[2] = $temp_and_starts[2]; $TTTPLOT[$index]->[3] = $temp_and_starts[3]; $TTTPLOT[$index]->[4] = $max_SF; push $TTTPLOT[$index], @twenty_SFs; $index++; } # Trim the overlapping tails off each combination of curves my @Fs = map \$_->[1], @TTTPLOT; # create an array of references my @Ps = map \$_->[2], @TTTPLOT; my @Bs = map \$_->[3], @TTTPLOT; trim_curves(\@Fs, \@Ps, $index); # check for ferrite greater than +pearlite trim_curves(\@Fs, \@Bs, $index); # check for ferrite greater than +bainite trim_curves(\@Ps, \@Bs, $index); # check for pearlite greater than + bainite # Output each row to the output file foreach my $row (@TTTPLOT) { say $out (join "\t", @{$row}); # tab-separated } close $in; close $out; return; } parse_file("./TTTPLOT.DAT", "./TTTPLOT_PARSED.DAT");

    This parsed file is never being generated obviously which is why none of the data is being graphed.

    Thank you to anyone who can provide some insight, I am sorry I have little to no experience working with Perl.

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 wandering the Monastery: (4)
As of 2021-07-28 10:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?