Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister

The Monastery Gates

( #131=superdoc: print w/replies, xml ) Need Help??

If you're new here please read PerlMonks FAQ
and Create a new user.

poll ideas quest 2021
Starts at: Jan 01, 2021 at 00:00
Ends at: Dec 31, 2021 at 23:59
Current Status: Active
2 replies by pollsters
    First, read How do I create a Poll?. Then suggest your poll here. Complete ideas are more likely to be used.

    Note that links may be used in choices but not in the title.

Perl News
The "A" in awk has gotten a special award
on Mar 31, 2021 at 20:04
1 reply by perlfan
Security Issues in Perl IP Address distros
on Mar 30, 2021 at 08:59
3 replies by choroba
    Security Issues in Perl IP Address distros


    • Net-Netmask: Vulnerable before 2.00000 release. Upgrade now.
    • Net-CIDR-Lite: Affected and unmaintained.
    • Net-IPAddress-Util: Affected.
    • Data-Validate-IP: Depends on exactly how itís used. See below for details.
    • Socket: Appears unaffected.
    • Net-DNS: Appears unaffected.
    • NetAddr-IP: Appears unaffected.
    • Net-Subnet: Appears unaffected.
    • Net-Patricia: Appears unaffected.

    map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
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; }
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 }
use alternate module if pm is not installed
8 direct replies — Read more / Contribute
by agweih
on Apr 07, 2021 at 04:46

    Dear monks,

    my perlscript should run on different systems (windows, linux) where I don't know which modules are installed and I don't have permission to install modules.

    Therefore I'm looking for a way to fallback to core modules or my own pm with basic functionality if a module is not installed.

    My naive thought was using something like this:

    use JSON || JSON::PP;

    this does of course not work.

    What's the best way to do this?

    thanks in advance!

    greetings, Toni

STDIN Enter key not quite working
2 direct replies — Read more / Contribute
by slugger415
on Apr 05, 2021 at 15:49

    Hi all, probably a dumb question, but I am using <STDIN> to collect user information on a Perl script on Mac OSX. For some reason pressing Enter moves the cursor to the next line, and only by pressing control-D can I get it to continue. And control-D by itself doesn't do it either. Naturally I'd like the Enter key to be the only thing needed. Am I doing something wrong?

    #!/usr/bin/perl print "How many cookies do you want? Enter number: "; my($cookies) = <STDIN>; chomp($cookies); print "You wanted only $cookies?\n";

    Thanks -

printing contents of a hash
3 direct replies — Read more / Contribute
by merrittr
on Apr 05, 2021 at 02:53

    Hi All

    I have a HASH built like this

    { . my @theta = $reg->theta(); $reg_coes{$id} = $theta[1]; $reg->print(); } return \%reg_coes;

    what I want to do is print out the key and value in reg_coes, how do I do that?

use Devel::Pointer in threads
5 direct replies — Read more / Contribute
by exilepanda
on Apr 04, 2021 at 10:41
    I know thread::shared can't share deep data structure, so I attempt to only share the stringify memory address, and deref() it to access the structure inside the child thread. But what I got is really weird. Can someone help to explain how this happen? and any fix for this approach? Thank you very much
    $| = 1; use threads; use threads::shared; use Devel::Pointer; use Data::Dumper; $Data::Dumper::Sortkeys; my $Addr :shared; my $Deep = {OK=>1}; $Addr = address_of $Deep; sub A { while ( 1 ) { my $Data = deref $Addr; $Data->{A}++; print "Dumper in A tells:"; print Dumper $Data; print "B is now '$Data->{B}'"; # nothing! $Data->{B} = "Overide by A"; # The output suprised me! print $/; sleep 2; } } sub B { sleep 1; while ( 1 ) { my $Data = deref $Addr; $Data->{B}++; print "Dumper in B tells:"; print Dumper $Data; print "A is now '$Data->{A}'"; print $/; sleep 2; } } my $A = threads -> create ( 'A' ) ; my $B = threads -> create ( 'B' ); $A->detach; $B->detach; while ( 1 ) { $Addr = address_of $Deep ; sleep 1 } __END__ Surprising Output: Dumper in A tells:$VAR1 = { 'A' => 1, 'OK' => 1 }; B is now '' ## Nothing! Dumper in B tells:$VAR1 = { 'A' => 1, 'B' => 1, 'B' => 'Overide by A', ## POSSIBLE?! Same key in Hash?! 'OK' => 1 }; A is now '' ## Nothing too! Dumper in A tells:$VAR1 = { 'A' => 2, 'B' => 1, 'B' => 'Overide by A', 'OK' => 1 }; ...
"Magic tools" that take the fun away
6 direct replies — Read more / Contribute
by hrcerq
on Apr 08, 2021 at 16:18

    Hi, folks.

    Recently I've found (here in PerlMonks) a link to one of Donald Knuth's great talks: Computer Programming as an Art. Knowing it was Knuth's sutff, I knew it would be worth my time.

    One of the (often overlooked) benefits of computer programming is that it can be fun. But Knuth goes beyond that stating that it should be fun and that a program should be beautiful. Fun and beauty add a lot of value to the program and to programming.

    Now, at the same time, observing the IT industry as whole, we can see how much the fun and beauty of programming are being overlooked. More and more "magic tools" are making way to sysadmin jobs, and they're focused on people who don't want to program. IT managers often see them as a means "not to depend too much on programmers". It's laughable, but I've seen it a lot.

    One example of such tools are the configuration management tools, such as Ansible, Puppet, Chef and similar tools, which take a more declarative approach to systems management. I'm not saying these tools aren't useful (or even that they are necessarily bad), but I feel like they've taken a lot of the fun away from systems management.

    This is not to mention GUI-only tools, which are mostly closed-source. Fortunately I've been far from them. But currently at my job, I help maintain some Ansible routines, and sometimes it's a daunting task. I can't remember how many times I had to grep a repository to find out when some variable was being set. If a declarative approach should be friendly, then I must say it has failed in my case, because the repository I work with has grown into a messy beast (I'm sure my co-workers agree).

    Yet, I remember once I've put a perl one-line command in a playbook and was critized precisely for this action. I was told it would bring complexity and that other people would have difficulty maintaining perl code. Can you believe it? A one-line! I'd say it's a joke if someone else told me.

    Of course, I wouldn't give up on Perl because of that. But it makes me wonder why must we always prove something that exists for decades is worthy a try, while something created a few years ago is promptly accepted. Of course, it's just my point of view, which not necessarily happens everywhere. Other points of view would be much appreciated.

PerlMonks Discussions
The Categorized Questions and Answers section has been decommissioned
1 direct reply — Read more / Contribute
by jdporter
on Apr 09, 2021 at 15:47

    Effective today, the section of PerlMonks known as "Categorized Questions and Answers" is no longer in service. The section page is a tombstone. It is no longer possible to post Categorized Questions or Answers. It is also not possible to search such posts via Super Search. It wouldn't be useful anyway, because all of the posts which were Categorized Questions have been converted into SOPW posts. Likewise, all posts which were Categorized Answers have been converted into replies to those SOPW posts. In each case, the name of the CatQA 'section' in which the Question was places has been added to SOPW post as a keyword.

    The intent of the CatQA section will, going forward, be fulfilled by a new system, whereby "good" questions (in SOPW) and their "best" answers will be given a special flag, as well as relevant keywords.

    Some documentation and linkage changes remain to be made. If you see any, feel free to sent a msg to SiteDocClan, pmdev, or gods, depending.

    For more information on this change, see prior discussion: RFC: Better Best Answers Gets Real

    I reckon we are the only monastery ever to have a dungeon staffed with 16,000 zombies.
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 avoiding work at the Monastery: (5)
As of 2021-04-10 15:26 GMT
Find Nodes?
    Voting Booth?

    No recent polls found