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   = "hdshcresearch.asu.edu";
    }
    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'};
}
[download]

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

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

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;
}
[download]

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 );
[download]

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 );
[download]

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);
[download]

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);
[download]

Null output. How about typing it in directly?

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

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);
[download]

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?

Thanks!

# 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";
}
[download]

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)
[download]

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
$node->{parentElement}
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.

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="https://www.w3schools.com"
  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
  xsi:schemaLocation="https://www.w3schools.com http://www.w3schools.c
+om/xml/note.xsd">
  <!--
  xsi:schemaLocation="https://www.w3schools.com file:///root/stef/note
+.xsd">
  -->
  <to>Tove</to>
  <from>Jani</from>
  <heading>Reminder</heading>
  <body>Don't forget me this weekend!</body>
</note>
[download]

If I swap with the commented out line (i.e. I change http://www.w3schools.com/xml/note.xsd 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 http://www.w3schools.com/xml/note.xsd 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 http://www.w3schools.com 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 ================

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/UserAgent.pm 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.
[download]

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?

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 serial_io.pl line 20.
Use of uninitialized value $got in numeric ne (!=) at C:/appl/strawber
+ry64/perl/site/lib/Win32/SerialPort.pm line 1560.
: ACK
[download]

#!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
}
[download]

How to store all 1 s in perl

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

output is coming as

1.11111111111111e+130

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

What is the right step.

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");
}
[download]

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