Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

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
DBD::mysql incorrect string value
3 direct replies — Read more / Contribute
by cormanaz
on Apr 09, 2021 at 20:02
    Hi all. I have some tweets in Russla/Ukrainian/Bulgarian in a database on another machine. I have extracted ones I want to translate using google cloud translate, which is installed on another machine. I loaded them into an array of hashes, dumped them into a Storable file, and moved that to the other machine. I am now trying to load these into a MySQL database and an getting an error I can't figure out on the other machine. Here is the code (I set the die on $sth->execute to print the error and offending values):
    use DBI; use Storable qw(retrieve); $| = 1; my $j = retrieve("/mnt/c/temp/to-translate.sto"); my $dbh = connectdb('****','****','****','****','****'); foreach my $i (0..@$j-1) { my $r; $r->{tid} = $j->[$i]->{id}; $r->{orig} = $j->[$i]->{text}; #print "$r->{tid}\t$r->{orig}\n"; insertsql($dbh,'translate',$r); } sub connectdb { # connects to mysql or PgPP my ($database,$user,$password,$driver,$server) = @_; unless ($driver) { $driver = "mysql"; } unless ($server) { $server = ""; } my $url = "DBI:$driver:$database:$server"; unless ($user) { $user = "root"; $password = "research.HDSHC.mysql"; } my $dbh = DBI->connect( $url, $user, $password ) or die "connectdb + can't connect to mysql: $!\n"; return $dbh; } sub insertsql { my ($dbh,$table,$data,$ignore) = @_; my @qm; my @keys; my @values; my $i = -1; foreach my $k (keys %$data) { if (defined($data->{$k})) { $i++; $keys[$i] = $k; $values[$i] = $data->{$k}; $qm[$i] = '?'; } } my $keylist = join(",",@keys); my $qlist = join(",",@qm); my $sqlstatement = "insert into $table ($keylist) values ($qlist)" +; if ($ignore) { my $sqlstatement = "insert ignore into $table ($keylist) value +s ($qlist)"; } my $sth = $dbh->prepare($sqlstatement); #$sth->execute(@values) || die "putsql could not execute MySQL sta +tement: $sqlstatement $sth->errstr"; $sth->execute(@values) || die $sth->errstr. " ".join(" ",@values); $sth->finish(); return $dbh->{'mysql_insertid'}; }
    The encoding on the original db is utf8, and so are the table and columns on the target db. When it gets to one particular item it croaks:

    Incorrect string value: '\xF0\x9F\x98\x84 "...' for column 'orig' at row 1 530248086468063232 Нужно срочно брать на роботу. Цель для него есть 😄 "Рассекречена личность морпеха застрелившего бин Ладена"  at /home/steve/ line 61.

    Is the problem the emoticon? If so, how can I filter these out?

Adding Filename to the end of each line
1 direct reply — Read more / Contribute
by jalopez453
on Apr 09, 2021 at 15:28

    I am trying to add the filename to the end of each line in my files. I tried a few solutions but none seem to work and this is what I have. I am not sure what I am missing or what is wrong.

    #!/usr/bin/perl -w use strict; use warnings; use Text::ParseWords; opendir IN, 'Master'; my @in = grep { /\.txt$/ } readdir IN; # read all file names form dir +except names started with dot closedir IN; for my $in (@in) { open IN, '<', "Master/$in" || next; open OUT, '>', "Update/$in" || die "can't open file Update/$in"; my @file = @in while (my $file = <IN>) { my $line = $_; $updateline = $line . $file; print OUT "$updateline"; } close OUT; close IN; }
Formatting Regex for File::Find::Rule
1 direct reply — Read more / Contribute
by springgem
on Apr 09, 2021 at 10:52

    I'm new to PerlMonks and fairly new to PERL. Long story short, I'm trying to clean up and speed up code and am struggling with Find::File::Rule. I read other posts here and on StackOverflow that helped, but I can't get to that last little bit.

    The story: I want to build a list of directories or files, but exclude some based on patterns.

    It started with:

    find ( { no_chdir => 0, wanted => sub { return unless -d; # skip files; we're tagging folders return if $File::Find::name =~ /\/\./; return if $File::Find::name =~ /\./; return if $File::Find::name =~ /\.store$/i; return if $File::Find::name =~ /\/LOG(\/|$)/i; return if $File::Find::name =~ /\.go\./i; return if $File::Find::name =~ /\/cache(\/|$)/i; return if $File::Find::name =~ /\.store$/i; return if $File::Find::name =~ /\/AVCHD(\/|$)/i; push ( @fileList, $File::Find::name ); # get name with path }}, $tagLocation );

    Hideous, but it worked. So I cleaned it up to:

    our @dirExclusions = qw( \. \/LOG(\/|$) \/cache(\/|$) \/AVCHD(\/|$) ); # call regex only once our $dirExclusionsQR = join( '|', @dirExclusions ); # compile the expression $dirExclusionsQR = qr{$dirExclusionsQR}i; my @fileList3; find ( { no_chdir => 0, wanted => sub { return unless -d; # skip files; we're tagging folders return if $File::Find::name =~ $dirExclusionsQR; push ( @fileList3, $File::Find::name ); }}, $tagLocation );

    Much better, and I get the benefit from qr//. Life is good. Now I want to make it more readable and perhaps faster with "File::Find::Rule" and ->name()->prune. So:

    our @dirExclusions = qw( \. \/LOG(\/|$) \/cache(\/|$) \/AVCHD(\/|$) ); our @dirExclusionsQR = map { qr/$_/i } @dirExclusions; my $rule = File::Find::Rule->new; $rule->or( $rule->new->directory->name( @dirExclusionsQR )->prune->discard, $rule->new->directory); my @fileList2; @fileList2 = $rule->in($tagLocation);

    This version doesn't return anything. I'll spare you the variants of putting qr inside @dirExclusions, using q() instead of qw(), taking off the '\/' (on the assumption File::Find::Rule wasn't matching on the full path), and such.

    Next attempt: use a string, as in @fileList3 above.

    our @dirExclusions = qw( \. \/LOG(\/|$) \/cache(\/|$) \/AVCHD(\/|$) ); our $dirExclusionsQR = join( '|', @dirExclusions ); $dirExclusionsQR = qr{$dirExclusionsQR}i; my $rule = File::Find::Rule->new; $rule->or( $rule->new->directory->name( $dirExclusionsQR )->prune->discard, $rule->new->directory); my @fileList2; @fileList2 = $rule->in($tagLocation);

    Null output. How about typing it in directly?

    $rule->or( $rule->new->directory ->name( qr/(\.|\/LOG(\/|$)|\/cache(\/|$)|\/AVCHD(\/|$))/i ) ->prune->discard, $rule->new->directory);

    Doesn't work either.

    Finally, out of desperation:

    our @de = qw (*.* LOG cache AVCHD); my $rule = File::Find::Rule->new; $rule->or( $rule->new->directory->name( @de )->prune->discard, $rule->new->directory); my @fileList2; @fileList2 = $rule->in($tagLocation);

    It does work, but I cannot use regex and I don't think the wildcards are compiled. And it doesn't solve my regex issue. What am I missing?


trying to print hashes with mixed results
3 direct replies — Read more / Contribute
by merrittr
on Apr 08, 2021 at 21:56
    Here is my code and the results below, see how the hashes are printed not the values any ideas how I can get the data?
    # read subplot ANOVA results my ($subplot_ERROR, $subplot_BLOCK) = &read_subplot_anova_stats($subpl +ot_anova_file); ###################################################################### +###### ##my $hash_ref = mysub(); while (my ($k, $v) = each(%$subplot_ERROR)) { print "error:$k = $v\n"; }
    error:2019/Preston/W1 = HASH(0x3759530) error:2019/Preston/V2 = HASH(0x36378e0) error:2019/Preston/W3 = HASH(0x3640140) error:2019/Preston/V1 = HASH(0x3642ca8) error:2019/Preston/W2 = HASH(0x3637850) error:2019/Preston/STD = HASH(0x363fde0) error:2019/Preston/V3 = HASH(0x3764478) Block:2019/Preston/V1 = HASH(0x3637ec8) Block:2019/Preston/W2 = HASH(0x3643218) Block:2019/Preston/V3 = HASH(0x37565a8) Block:2019/Preston/STD = HASH(0x3642c90) Block:2019/Preston/W1 = HASH(0x3631b38) Block:2019/Preston/V2 = HASH(0x3626c80) Block:2019/Preston/W3 = HASH(0x375b610)
WWW::Mechanize::Chrome -> Access Parent Node
No replies — Read more | Post response
by 1nelly1
on Apr 08, 2021 at 14:05

    I have problems to navigate in the DOM tree. Starting from a node $node (WWW::Mechanize::Chrome::Node) in WWW::Mechanize::Chrome I would like to access the parent node. In WWW::Mechanize::Firefox I did this by using for example an XPath like
    @parent_node = $mech->xpath('./parent::*', node => $node )
    However it was also possible to directly access nodes like for instance with
    I do not know how to realize this in WWW::Mechanize::Chrome. The author of that module writes in the documentation regarding my first approach: "Querying relative to a node only works for restricting to children of the node, not for anything else. This is because we need to do the ancestor filtering ourselves instead of having a Chrome API for it." Regarding my second approach I noticed that the WWW::Mechanize::Chrome::Node-Object is providing a parentID but I could not figure out how this will help. How can I access a node-object by using this ID?

    I would like to know how to access a parent node in order to generate an xpath from a node as I did within WWW::Mechanize::Firefox. Another solution could be the use of the callFunctionOn-function provided by WWW::Mechanize::Chrome and to realize that with JavaScript. However I did not check this out so far.

    If the problem with the parent node is solvable then the next problem will be that I will need something like
    @preceding_sibling = $mech->xpath("count(preceding-sibling::$node_name)", node => $node )
    I did not check if this will work in WWW::Mechanize::Chrome.

How Xerces validation access http schemas ?
4 direct replies — Read more / Contribute
by jjmoka
on Apr 08, 2021 at 07:53
    This self contained example (pathname: /root/stef/ works fine on a server A-OK, while it doesn't work on another server B-NOK.
    use strict; use XML::Validate::Xerces; sub main { my $rsep = $/; undef $/; my $xml = <DATA>; $/ = $rsep; warn "working on this xml:[\n$xml]"; my %options; my $validator = new XML::Validate::Xerces(%options); my $valid = $validator->validate($xml) ? '' : 'in'; warn "Document is ${valid}valid\n"; } main(); __DATA__ <?xml version="1.0"?> <note xmlns="" xmlns:xsi="" xsi:schemaLocation=" http://www.w3schools.c +om/xml/note.xsd"> <!-- xsi:schemaLocation=" file:///root/stef/note +.xsd"> --> <to>Tove</to> <from>Jani</from> <heading>Reminder</heading> <body>Don't forget me this weekend!</body> </note>

    If I swap with the commented out line (i.e. I change to be file:///root/stef/note.xsd) so with the schema as a local file, then it works fine even in B-NOK.

    The only difference then seems when the schema is on http.

    Note that, the local file was downloaded as wget so that not only I know that the content of the schema file is the same (local & remote) but also that http:80 works fine to catch stuff out there.

    I didn't do anything special to have Xerces working over http:80 for server A-OK. I would then expect to do nothing on server B-NOK to have Xerces going out there and grab the schema.

    I didn't find clear info if/how Xerces should be instructed to use http. Neither which mechanism it has built-in, to behave like wget to download URLs. I cannot understand then if I must add some config vars. The admin of server B-NOK told me that he didn't see anything attempting to reach apart when doing the manual wget. This does seem Xerces doesn't bother at all to get that URL.

    Really thank you in advance for any hint.

    ====================== SOLVED / UPDATE ================
    I wasn't given details but network settings on B-NOK server and behind have been performed and currently that fixed my issue.
    I'm left then embarrassed to come here and apologise to everyone for the time spent on this.
    To be honest I've spent ages and I didn't know what much else to try. 
    I've had the opportunity to learn from the good advices received so that's still a positive outcome for me.
    For you instead again my apologies.
    ====================== SOLVED / UPDATE ================
Weird perl issue, installed packages not being recognized
4 direct replies — Read more / Contribute
by kvn95ss
on Apr 08, 2021 at 02:26

    Hello, newbie here so please help me in the nightmare I'm stuck.

    I'm currently running an RHEL server which has perl installed from yum. I'm trying to install a software called Ensembl-VEP which needs certain perl packages, few of them being LWP::UserAgent,XML::DOM and BioPerl. The issue is, according to cpanm and yum, the packages have already been installed!! However, when I try to use the modules with this - perl -e "use LWP::Agent" I get this error -

    Can't locate LWP/ in @INC (you may need to install the LWP +::UserAgent module) (@INC contains: /root/perl5/lib/perl5/ /usr/local +/bin/perl /usr/local/lib/perl5/site_perl/5.32.1/x86_64-linux /usr/loc +al/lib/perl5/site_perl/5.32.1 /usr/local/lib/perl5/5.32.1/x86_64-linu +x /usr/local/lib/perl5/5.32.1) at -e line 1. BEGIN failed--compilation aborted at -e line 1.

    Since I'm not the one who installed perl onto this system, nor can I contact them, what is the best possible solution to resolve this issue?

How to read serial port with WIN32:SerialPort?
2 direct replies — Read more / Contribute
by mastertone
on Apr 08, 2021 at 00:34

    I am communicating with equipment on a USB COM port using USB-RS485 serial port adapter using Win32::SerialPort A CMD message of six bytes is sent to Equipment, which responds with ACK message.

    However, I have trouble reading the ACK messsage returned from Equipment from the COM port. I have used  $PortObj->input; $PortObj->lookfor();  $PortObj->read() to retrieve the string from COM port, but it does not show up.

    Port characteristics are: Datarate = 115200 bps, 1 start bit, 8 databits, 1 stop bit, odd parity. 1 Byte = 11 bits. Each 11-bit byte has duration 11/115200 = 95.49 us. Timing is approx: 0.5msec: CMD message six bytes duration, 2 msec later ACK message, 2msec ACK message duration. 20 msec between successive CMD messages.

    Nearly any combinations of values on  $PortObj->read_interval(), $PortObj->read_char_time(), $PortObj->read_const_time() times, but it does not read the the COM port. I tried these methods and they do not read COM port, and gives in Error messages,

    : CMD 01 61 00 00 01 61 Second Read attempted before First is done at line 20. Use of uninitialized value $got in numeric ne (!=) at C:/appl/strawber +ry64/perl/site/lib/Win32/ line 1560. : ACK
    Also, is the command 20 millisec between port writes sleep( 0.020 ) a problem? Any advice how to read COM port? - Mastertone "Longtime Reader, First time poster"

    #!C:\appl\strawberry64\perl\bin use strict; use warnings 'all'; use Win32::SerialPort; use Time::HiRes qw (time sleep); use Data::Dumper; my $PortObj_r = &com_port_initialize() ; my @byte = (0x01, 0x61, 0x00, 0x00, 0x01, 0x61 ); my $str = ": CMD "; foreach ( @byte ) { $str .= sprintf(" %02X", $_)}; my $string_in; my $count_in; while () { my $PortObj_r = &get_PortObj; # Call Port Obj # my $PortObj = $$PortObj_r; print "$str \n"; foreach my $num ( @byte ) { $PortObj->transmit_char($num) } $string_in = $PortObj->input; # Error: Line 20 ** # # $string_in = $PortObj->lookfor(); # Error: Line 21 ** # # ($count_in, $string_in) = $PortObj->read(1); # Error: Line 22 # print ": ACK "; print $string_in; print "\n"; sleep( 0.020 ); # 20 millisec between writes undef $PortObj; } # ----------------------------------------- sub get_PortObj { $PortObj_r; } # -------------------------------------------------------- # PortObject Definiton # -------------------------------------------------------- sub com_port_initialize { my $quiet = 1; $| = 1; my $PortName = "COM10"; my $PortObj = new Win32::SerialPort ($PortName, $quiet) || die "Error: Can't open $PortName: $^E\n"; print "> PortName = ", $PortObj->alias, "\n"; my $dataRate = 115200; my $read_bufferSize = 4096; my $write_bufferSize = 4096; my $char11_t = (11/$dataRate) ; # 95.49 us = 0.095 msec my $readChar_t = 1 ; # in millisec; char11_t my $readConst_t = 2; # read_const_time my $readInterval_t = 10; my $writeCharTime = 1; my $writeConstTime = 0; $PortObj->handshake("none"); $PortObj->user_msg("ON"); $PortObj->baudrate($dataRate); $PortObj->databits(8); $PortObj->parity("odd"); $PortObj->stopbits(1); $PortObj->binary('T'); $PortObj->parity_enable('T'); $PortObj->debug(0); $PortObj->buffers($read_bufferSize, $write_bufferSize); $PortObj->read_interval($readInterval_t ); $PortObj->read_char_time($readChar_t ); $PortObj->read_const_time($readConst_t); $PortObj->write_char_time($writeCharTime); $PortObj->write_const_time($writeConstTime); $PortObj->write_settings || undef $PortObj; my $ModemStatus = $PortObj->modemlines; if ($ModemStatus & $PortObj->MS_RLSD_ON) { print "> Carrier Detect +ed"; } open OUTFILE, ">portObj.txt" or die "Error: Cannot open portObj.txt $!\n"; print OUTFILE "> PortObj = ", Dumper \\$PortObj; close OUTFILE; \$PortObj; # return reference to $PortObj }
How to store all 1 s in perl
3 direct replies — Read more / Contribute
by suvendra123
on Apr 07, 2021 at 21:15

    How to store all 1 s in perl

    my $value = 1 x 131/ 1; my $value1 = $value; print "$value";

    output is coming as


    But I want variable $value1 as all 1's 131 times instead of e+130

    What is the right step.

File::HomeDir methods my_dist_data and my_dist_config do nothing on Win32
2 direct replies — Read more / Contribute
by Intrepid
on Apr 07, 2021 at 18:49
    <meta http-equiv="Content-type" content="text/html;charset=cswindows1252">

    Hello good monks. I am trying to manage data associated with perl programs and these subroutines from File::HomeDir would seem to be a good starting place, but they do nothing (I am running StrawberryPerl on Windows 10). They return "undefined".

    Both subs rely on my_data which looks like this:

    sub my_data { $IMPLEMENTED_BY->can('my_data') ? $IMPLEMENTED_BY->my_data : Carp::croak("The my_data method is not implemented on this pla +tform"); }
    I'd expect that if not implemented, the code would croak, which it does not do. Can anyone shed light on this module? Thanks in advance.

    [localtime:// PUT ISO-8601 TIME HERE followed by UTC]

    Examine what is said, not who speaks.
    Love the truth but pardon error.
    Silence betokens consent.
    In the absence of evidence, opinion is indistinguishable from prejudice.

Add your question
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.
  • Log In?

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

    How do I use this? | Other CB clients
    Other Users?
    Others surveying the Monastery: (3)
    As of 2021-04-10 12:33 GMT
    Find Nodes?
      Voting Booth?

      No recent polls found