http://www.perlmonks.org?node_id=479

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
CGI URL simple
1 direct reply — Read more / Contribute
by Anonymous Monk
on Feb 21, 2020 at 13:23

    Hello

    I have a very naive question about CGI. I have a small CGI script that generates a basic HTML page. The script is called by a URL such as

    http://mydomain.com/cgi-bin/mobile/generateHTML.pl

    Everything works fine. What I do not like is that in the URL bar I see this monster URL (http://mydomain.com/cgi-bin/mobile/generateHTML.pl). Is there any way to maybe reduce it to http://mydomain.com or something similar (of course without changing page)?

User-side module building with ExtUtils::MakeMaker
2 direct replies — Read more / Contribute
by merkys
on Feb 21, 2020 at 07:18
    Hello, I am interested in autogenerating Perl modules for my distribution during user-side builds. To be precise, I have a Parse::Yapp-driven module, which I want to build on the user's side (motivation: 1. the parser is too huge to include it in the source distribution, 2. SPOT/DRY). To build the module on the user-side, I add the following to WriteMakefile of Makefile.PL (using ExtUtils::MakeMaker):
    depend => { pm_to_blib => 'blib/lib/OPTiMaDe/Filter/Parser.pm' },
    and, at the end of the Makefile.PL:
    sub MY::postamble { <<'EOT' blib/lib/OPTiMaDe/Filter/%.pm: %.yp mkdir --parents $(@D) yapp -v -m OPTiMaDe::Filter::Parser -o $@ $< EOT }
    However, CPAN Testers run into a variety of troubles, from inability to find the rules to make the dependency, to 'yapp' not being found, and mkdir not working (mainly Windows). My question: is there a standard way to write plugins for ExtUtils::MakeMaker (Dist::Zilla or any other equivalent) to produce Perl modules on the client side?
selectrow_array installation
1 direct reply — Read more / Contribute
by AjayUSAPerl
on Feb 20, 2020 at 23:30
    I'm using PERL Web application programs that have been built for and distributed by our organization. It has been working properly on a LiquidWeb installation running cPanel 76.0.22 Linux system. I'm now ported the same code base into another installation running on GoDaddy running cPanel 78.0.38 Linux system. The application works fairly well except at a crucial place. After much tracing, I found that the 'selectrow_array() always returns an empty list. If I use individual prepare-execute-fetch calls, it works. Of course, I don't want to change the code all over the place because selectrow_array is used everywhere. The Perl modules are installed by default by GoDaddy and I can make changes if I knew what to change. Anybody seen this type of error and what am I missing in the installation? Thanks Ajay
PPM missing in ActiveState 5.28 trying to install IMage::Magick
4 direct replies — Read more / Contribute
by RedJeep
on Feb 20, 2020 at 18:45
    Hello friends. ActiveState has EOL'd PPM. I have a server with v5.28. Apparently killed off at 5.26. I am trying to install IMage::Magick I looked at the docs like PPM Index and ImageMagick.org but can't figure out how to install this module. I will also need to install other modules. My environment is ActiveState across multiple servers, so I would rather avoid switching over to StrawBerry. Any ideas?
Mass Class Confusion - Who calls what how?
3 direct replies — Read more / Contribute
by holandes777
on Feb 20, 2020 at 14:36

    Hi Monks:

    I am attempting to learn how to use objects and have made progress, but here I am stymied. I am using HTTP::Server::Simple::CGI;= and having cognitive difficulties getting it to pass the incoming message to another class. I thought the answer was in the post_setup_hook method, but when I try to run I get a error that says I cannot call SUPER when I reach the handle_request method.

    What I am trying to do below is to geth the message from the handle_request method of HTTP::Server::Simple::CGI;= to the process method of the Kiosk package and then to get the response to go back out. I tried passing the Kiosk object into the server first adn that did not work because I don't see how to add this to the "new" method of the server, so now I am trying to pass the server into the Kiosk module and attempting to get a hold of the message

    this is the main program, as you can see I instantiate the server adn pass it to the Kiosk

    #!/usr/bin/perl { package MyWebServer; # https://metacpan.org/pod/HTTP::Server::Simple # curl --header "Content-Type: application/json" --request POST -- +data '{ "type":"cardCheck", "date":"1482307795601", "lang": "EN", "ma +chineName":"PLUSMAKM", "cardNumber":"1234567890", "PIN": "1234" }' ht +tp://localhost:2999 use lib qw (/home/pi/cashcade /home/gary/projects/cashcade); use HTTP::Server::Simple::CGI; use base qw(HTTP::Server::Simple::CGI); # use HTTP::Server::Simple; # use base qw(HTTP::Server::Simple); use Data::Dumper; use JSON; sub handle_request { my $self = shift; my $cgi = shift; my $json_string = $cgi->param('POSTDATA'); # { "type":"cardCheck", "date":"1482307795601", "lang": "EN", +"machineName":"PLUSMAKM", "cardNumber":"1234567890", "PIN": "1234" } print "json_string=$json_string\n"; $json_dict = decode_json $json_string; print "json_dict=" . Dumper($json_dict) . "\n"; my $msg = $json_dict->{param}->{POSTDATA}->[0]; # my $response = $self->{kiosk}->process($msg); # note: this +says I cannot call on undefined, the problme is, how do I pass the ob +ject in # print "response=$response\n"; return $msg; } } sub sigIntHandler { exit; } END { print "MAIN: END*END*END*END*END*END*END*END*END*END*END*END*END*E +ND\n"; $kiosk->disconnect(); } my $kiosk_port = shift // 'unknown'; die "FATAL ERROR: Need to specify a port\n" unless ($kiosk_port ne 'un +known'); my $placard = shift // 'unknown'; die "FATAL ERROR: Need to specify a placard\n" unless ($placard ne 'un +known'); my $debug_level = shift // 9; # TODO: make level higher on final print "$placard, $debug_level\n"; use Kiosk; # start the server on port __ print "INSTANTIATING SERVER port $kiosk_port ========================= +=====\n"; my $server = MyWebServer->new($kiosk_port); print "INSTANTIATING KIOSK ==============================\n"; $kiosk = Kiosk->new($placard, $server, $debug_level);

    In the Kiosk module (the first part below, I run the server when I instantiate the Kiosk

    package Kiosk; # This implements communications to a VNE kiosk as an HTTP server # based on VNE JSON Communication Protocol Ver. 1.8 # Alessandro: add to protocol: change PIN? There is no card removed me +ssage use strict; use Device::SerialPort; #use Data::CISerializer; #use MIME::Base64; #use JSON; use Time::HiRes qw(usleep gettimeofday tv_interval time); use Data::Dumper; use Debug; use GetConfiguration; use Database; use DatabaseProcesses; $|=1; sub new { my ($class, $placard, $server, $debug_level) = @_; # config is a d +ata structure that has serial setup information my $self = {}; $self->{me} = 'Kiosk'; $self->{class} = $class; $self->{placard} = $placard; $self->{server} = $server; $self->{debug} = Debug->new($placard, "MAIN_$placard", $debug_leve +l); $self->{config} == GetConfiguration->new($self->{debug}, '/etc/cas +hcade/cashcade.conf'); $self->{debug}->prt(9, "KIOSK Config " . Dumper($self->{config}), +'KIOSK'); $self->{dbcomm} = Database->new($self->{debug}, $self->{configurat +ion}->{config}->{local_db}); # the DB connection must go first and su +cceed $self->{dbcomm}->connect(); die "Database unable to connect!" if (!$self->{dbcomm}->{connected +}); print "Database Connected\n"; $self->{dbproc} = DatabaseProcesses->new($self->{debug}, $self->{d +bcomm}); $self->{maxDeposit} = $self->{config}->{maxDepositCents}; $self->{maxWithdraw} = $self->{config}->{maxWithdrawCents}; $self->{debug}->prt(2, "KIOSK CONFIG: kiosk_id=$self->{kiosk_id} m +axDeposit=$self->{maxDeposit} maxWithdraw=$self->{maxWithdraw}", 'KIO +SK INIT'); $self->{connected} = 0; $self->{verbose} = 0; $self->{kiosk_id} = $self->{dbproc}->get_kiosk_sysid_from_placard( +$self->{placard}); $self->{card_number} = 0; # this is the latest card number seen $self->{account_id} = 0; # this is the account id while the card i +s in the reader of the kiosk $self->{account_value} = 0; # value of account in cents $self->{response} = ''; $self->{server}->run(); bless($self,$class); return $self; } sub process { my ($self, $msg) = @_; # $msg is the pointer to the incoming mess +age json hash # { "type":"cardCheck", "date":"1482307795601", "lang": "EN", "mac +hineName":"PLUSMAKM", "cardNumber":"1234567890", "PIN": "1234" } # TODO: is message for this machine $msg->{machineName} # TODO: is date of message reasonable $msg->{date} $self->{response} = ''; if ( $msg->{type} eq 'cardCheck') { return $self->card_was_inserted($msg); } if ( $msg->{type} eq 'cardLoad') { return $self->deposit_amount_received($msg); } if ( $msg->{type} eq 'cardWithdrawal') { return $self->withdrawal_amount_requested($msg); } }

    Anyhow, I am confused after several hours of tinkering and appreciate your help.

Generating a CRC-16/XMODEM checksum in Hex
1 direct reply — Read more / Contribute
by Djinni
on Feb 20, 2020 at 12:37
    Hello,

    I am trying to generate a a CRC-16/XMODEM checksum. I have been using: http://reveng.sourceforge.net/crc-catalogue/16.htm#crc.cat.crc-16-xmodem and crccalc.com as a guide. As well as Digest/CRC.pm however I have been unable to get the perl module Digest::CRC to give me the expected result.

    #!/usr/bin/perl -w use strict; use Digest::CRC qw(crc64 crc32 crc16 crcccitt crc crc8 crcopenpgparmor +); my @s=( { 's'=>"9848C503738276ADCA02BF5DC1A3ABF2", 'crc16'=>"9F4B" }, { 's'=>"841374844ADDF4A36CEDB127C82086B9", 'crc16'=>"408E" }, { 's'=>"8AC1070ACD1659BB4F507191E33F7AD4", 'crc16'=>"E1E3" }, { 's'=>"34623A01DCDA35BED462953B4E2458DA", 'crc16'=>"7B40" }, { 's'=>"E29107CB32975E859D76A885BF57BE35", 'crc16'=>"2B92" }, { 's'=>"FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF", 'crc16'=>"0041" }, ); # width=16 poly=0x1021 init=0x0000 refin=false refout=false xorout=0x0 +000 check=0x31c3 residue=0x0000 name="CRC-16/XMODEM" my $width = 16; my $init = 0x0000; my $xorout = 0x0000; my $refout = 0; my $poly = 0x1021; my $refin = 0; my $cont = 0x31c3; for my $tv (@s) { my $crc16 = crc($tv->{s},$width,$init,$xorout,$refout,$poly,$refin +,$cont); print qq{ Input was: $tv->{s} crc: $crc16 -- Should be: $tv->{crc16} }; }
    I have another issue in that I do not understand what "cont" is here.
Inheritable configuration options.... but with default values?
4 direct replies — Read more / Contribute
by Amblikai
on Feb 20, 2020 at 11:57

    Hi Monks!

    I'm racking my brain with this one and can't seem to find an elegant solution. I hope you can help!

    Basically i have a series of classes and subclasses, each level adding a bit more functionality to its parent and in each class i have behaviour which can be modified by configuration options which are specific to that class

    All pretty straight forward so far. I can have a class method which sets the values of a hash which can be accessed by each object.

    However, how do i have default values for my configuration options (written into the class)? Which can be added to in each subsequent class?

    For example (Pseudo Code):

    package base; my %cfg=( on_error => "exit", output_type => "text", ); sub new { ..blah blah.. do_something if ($cfg{on_error} eq 'exit'); } package child; use parent "base"; my %cfg=( on_error => "warn", ); sub new {...}

    Where in the above example, the child class has the default value for "output_type" inherited from the parent class, but can change configuration options too

    I've set off in the direction of having a config class singleton which is instantiated (referenced) from within the child classes but i can't fathom how to give it default values in the manner above

    Thanks in advance for any help!

Get data from an XML file heading
2 direct replies — Read more / Contribute
by nachtmsk
on Feb 20, 2020 at 09:43
    Hi.

    So I have an XML file that I am parsing using XML::LibXML and it's working very nicely.

    The provider of the data is only returning 250 records initially. In the heading of the XML data is a section that tells how many records are in total, pages available, etc... See code below.

    It doesn't look like XML to me. Anyone know if if I can get XML::LibXML to get this data out for me. Particularly what I need is "total_pages", "total_records" and "download_key".

    If not, I guess a RegEx would be the way to go. Working on that now, but if anyone has an elegant suggestion, I'm listening.

    <result_summary total_records="594" total_pages="3" current_page="1" +records_this_page="250" download_key="xmxnxnxnxnxnxnxnxnx" time_start +="2020-02-19 15:50:55" feed_version="1.44" />
    Thanks, Mike
strange behavior of regex
2 direct replies — Read more / Contribute
by biologistatsea
on Feb 20, 2020 at 05:46
    Hello,

    I have a regex whose behavior doesn't match my expectations.

    The input data looks like this:

    . transcript_id "g29202.t1"; gene_id "g29202"; gene_name "G42051"; xloc "XLOC_053322"; cmp_ref "G42051.1"; class_code "c"; tss_id "TSS54758";

    . transcript_id "g29205.t1"; gene_id "g29205"; xloc "XLOC_053323"; class_code "u"; tss_id "TSS54760";

    . transcript_id "g29176.t1"; gene_id "g29176"; xloc "XLOC_053324"; class_code "u"; tss_id "TSS54761";

    . transcript_id "g29178.t1"; gene_id "g29178"; gene_name "G42030"; xloc "XLOC_053326"; cmp_ref "G42030.1"; class_code "o"; tss_id "TSS54763";

    The code below works fine:
    use warnings; use strict; my $usage = "perl select_bracker.pl [bracker gtf] [output id list]\n"; my $gfin = shift or die $usage; my $output = shift or die $usage; open(IN, '<', $gfin); open(OUT, '>>', $output); while (my $record = <IN>){ $record =~ s/\R//g; if ($record =~ /^.*transcript_id "([^"]*).*class_code "([^"]*)/){ my $trans = $1; my $class = $2; if($class eq 's' | $class eq 'x' | $class eq 'u'){ print OUT "$trans\n"; } } } close IN; close OUT;

    but if instead of if($class eq 's' | $class eq 'x' | $class eq 'u') I have  if('sxu' =~ /$class/g) then the script works fine for the first line with a particular '$class' value it reads, but if it has two adjacent lines with the same '$class' value, the regex doesn't match and the print loop doesn't run for the second line (eg line 3 of the example input). I don't understand this at all, so any help would be much appreciated! Alastair

Strange interaction between print and the ternary conditional operator
6 direct replies — Read more / Contribute
by WingedKnight
on Feb 19, 2020 at 22:17

    Ran into a strange interaction between print and the ternary conditional operator that I don't understand. If we do...:

    print 'foo, ' . (1 ? 'yes' : 'no') . ' bar';

    ...then we get the output...:

    foo, yes bar

    ...as we would expect. However, if we do...:

    print (1 ? 'yes' : 'no') . ' bar';

    ...then we just get the output...:

    yes

    Why isn't " bar" getting appended to the output in the second case?


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":


  • 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.