Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

The Monastery Gates

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

Donations gladly accepted

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

New Questions
[SOLVED] same utf8 string is different in console and in browser (Sybase)
3 direct replies — Read more / Contribute
by alexander_lunev
on Aug 19, 2017 at 10:45

    Hello, monks! I'm seeking for your wisdom!

    I'm getting strings from various SQL servers via DBI, and those are suppose to be utf8 russian strings. Getting utf8 strings from PgSQL is OK, but with Sybase strings in console looks ok, but when printed to browser via CGI, they're turns into ??????.

    The core of the program is this:

    my $dbh = DBI->connect($db{$dsn}{dsn},$db{$dsn}{user},$db{$dsn}{pa +ssword},$db{$dsn}{opts}); if (!defined($dbh)) { print "Error creating dbh: " . $DBI::errstr . "\n"; exit; } my $sth; $sth = $dbh->prepare($query); if (!$sth) { print "Error: " . $dbh->errstr . "\n"; exit; } if (!$sth->execute) { print "Error: " . $sth->errstr . "\n"; exit; } print "Content-Type: text/html; charset=utf-8\n\n"; my $ref = $sth->fetchrow_arrayref; my $str = $$ref[0]; print $db{$dsn}{driver}." ".$str ." > ".join(" ",map {sprintf("0x% +X",$_)} unpack("C*",$str))."\n";

    In console all strings and bytes are the same:

    # ./sql_test Content-Type: text/html; charset=utf-8 Sybase школы#Кас&#1089 +;а > 0xD1 0x88 0xD0 0xBA 0xD0 0xBE 0xD0 0xBB 0xD1 0x8B 0x23 0xD +0 0x9A 0xD0 0xB0 0xD1 0x81 0xD1 0x81 0xD0 0xB0
    # ./sql_test Content-Type: text/html; charset=utf-8 Pg школы#Касс&#1 +072; > 0xD1 0x88 0xD0 0xBA 0xD0 0xBE 0xD0 0xBB 0xD1 0x8B 0x23 0xD0 0x +9A 0xD0 0xB0 0xD1 0x81 0xD1 0x81 0xD0 0xB0

    But in browser:

    Sybase ?????#????? > 0x3F 0x3F 0x3F 0x3F 0x3F 0x23 0x3F 0x3F 0x3F 0x3F + 0x3F
    Pg школы#Касс&#1 +072; > 0xD1 0x88 0xD0 0xBA 0xD0 0xBE 0xD0 0xBB 0xD1 0x8B 0x23 0xD0 0x +9A 0xD0 0xB0 0xD1 0x81 0xD1 0x81 0xD0 0xB0

    So, it's not just browser glitch with encoding, but the very $str is changed!

    WHY?

    UPD: Solution is here 1197669.
Cpanel::JSON::XS crash under Perl 5.26.0
2 direct replies — Read more / Contribute
by Athanasius
on Aug 19, 2017 at 02:52

    I’m trying to install MongoDB for Strawberry Perl 5.26.0:

    This is perl 5, version 26, subversion 0 (v5.26.0) built for MSWin32-x +64-multi-thread-ld

    under Windows 8.1 64-bit. One of MongoDB’s dependencies is BSON. which not only fails to install but actually crashes the Perl interpreter while doing so.

    After some debugging I eventually reduced the problem code to the following SSCCE:

    use strict; use warnings; use JSON::MaybeXS; my $json_codec = JSON::MaybeXS->new; print ref $json_codec, "\n"; print $json_codec->encode( { d => 1.0 } ), "\n";

    Note that I have the following modules installed:

    16:27 >mversion -f JSON::MaybeXS Cpanel::JSON::XS JSON::XS JSON::PP JSON::MaybeXS 1.003009 Cpanel::JSON::XS 3.0233 JSON::XS 3.04 JSON::PP 2.94 16:27 >

    Now to the point: when I run the SSCCE, I get the following output:

    19:26 >perl 1800_SoPW.pl Cpanel::JSON::XS

    and the Perl interpreter crashes. But if I change the JSON module:

    19:26 >perl -MJSON::XS 1800_SoPW.pl JSON::XS {"d":1} 19:27 >

    the code completes successfully. I have also tested the SSCCE on Strawberry Perl 5.24.1, and it runs without a problem:

    16:37 >perl 1800_SoPW.pl Cpanel::JSON::XS {"d":1.0} 16:38 >

    So, I have two sets of questions:

    (1) Can other monks confirm this behaviour under Perl 5.26.0? If so, is it confined to Windows or does it occur on other platforms as well? And does anyone know of a change from 5.24 to 5.26 which could account for this? Should I report it as a bug under Cpanel::JSON::XS?

    (2) Until the bug is fixed, what’s the best way to prevent JSON::MaybeXS from defaulting to Cpanel::JSON::XS? I can add -MJSON::XS to the command line when invoking a Perl script directly, but how can I get cpanm to do this? Or will I need to uninstall Cpanel::JSON::XS from my system?

    Thanks,

    Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

Generic/Variable/Dynamic Subroutines? (Not a redefine)
3 direct replies — Read more / Contribute
by mlewando
on Aug 18, 2017 at 14:50
    I am working on some code for Nagios automations and was curious if there is a way to generalize the following:
    sub WriteLine { my $self = shift; my $it = $self->OStream->WriteLine($_[0]); $self->Trace(_CallerStr($it)); return $it; }; sub Select { my $self = shift; my $it = $self->OStream->Select($_[0]); $self->Trace(_CallerStr($it)); return $it; }; sub Add { my $self = shift; my $it = $self->OStream->Add($_[0]); $self->Trace(_CallerStr($it)); return $it; };
    To something along the line of:
    sub <Call> { my $self = shift; my $it = $self->OStream-><Call>($_[0]); $self->Trace(_CallerStr($it)); return $it; };

    Such that, I can use $Wrapper->Remove($item) and the function '<Call>' is executed and <Call> is substituted with 'Remove'. I can only think of using callbacks and a dispatcher but it seems like I would still have to generate all of the callback subs which I kind of want to avoid. Don't get me wrong it's not like copy/pasting is the end of the world, but why copy paste redundancy if there exists a method where I can almost template it? I would also like the simplicity in $X->Y->Z($item) and not have to work a dispatch and sub-call, which I have done before by passing a dispatch function a 'function name' like:

     if(defined $dev_desc{$tcp_data->Dispatch((USF::Modbus::Modbus::CB_NUMBERS))})

    But then I end up checking function name and data followed by execution, whereas I want something like (kind of a bad example but the point is there):

     if(defined $dev_desc{$tcp_data->Dispatch->Numbers($tcp_data->Value)})

    Maybe an overload? But then I would still have to have overload functions where all I really want to do is have it intuitively fill in the blacks since all of the functions will be doing the same thing since it is essentially a proxy class with subroutine tracing built-in for logging/debugging traceability. If it's not possible then oh well I guess, I just feel like there should be a better solution to excessive redundancy (especially when I am already using a proxy). I also feel it isn't entirely a thing since it would be a nightmare for the interpreter.

    Thanks

Trickery with Getopt::Long (flag option, with optional integer arg)
1 direct reply — Read more / Contribute
by stevieb
on Aug 18, 2017 at 11:03

    I'm in a position with Getopt::Long where I need to allow an option to operate as a flag, but also accept an argument to itself (an integer), and it also must set 0 as the flag value if no integer is passed along with it.

    The only way so far I've found to do it involves a bit of workaround, and I'm just wondering if I'm over thinking this. I haven't found another way to do this, so perhaps I'm overlooking something...

    use warnings; use strict; use Getopt::Long; my $arg = -1; { local $SIG{__WARN__} = sub { $_[0] =~ /^Option arg/ ? $arg = 0 : warn $_[0]; }; GetOptions( 'arg=i' => \$arg ); } print "$arg\n";

    So what that does is sets the argument variable to -1 as a default. If --arg|-a is sent in without an integer value along side it, I catch the warning and if it references the option properly, I set it to 0. If an integer is supplied to the option, things just work as normal.

    I'm happy with the code as it works very well, so I'm just looking to find out if there are built-in or other alternatives for this type of situation.

    Thanks,

    -stevieb

Nested loops?
5 direct replies — Read more / Contribute
by Speed_Freak
on Aug 17, 2017 at 15:18

    I am working with existing code, and trying to add a "filter" to it. Currently the code pulls an id number and a sequence from a table in the database.(sql1) A foreach loop then permutes each sequence and searches the list to find out if any of the alternates exists. This leads to way more matches than I need because the loop eventually gets to the existing alternates, permutes them, and finds all of the matches again, just with a different primary sequence. I created a second database pull that creates another list with the same id-sequence layout that contains only the primary keys that I want to evaluate. (sql2) I want to use this secondary list as the filter for which sequences are evaluated from the primary list, but I need each key identified in the secondary list to be evaluated against all of the primary list.

    #currently have strict turned off #code snippet foreach my $sql1 (@{$sql1}) { $table1{$sql1->[1]}{$sql1->[0]}=undef; #rearranges the sql pull } foreach my $sql2 (@{$sql2}) { $table2{$sql2->[1]}{$sql2->[0]}=undef; #rearranges the sql pull } my %hash = (); my @array = (); my @bases = ('A','C','G','T'); foreach my $tar1 (keys %table1){ foreach my $tar2 (keys %table2) { if ($tar1 eq $tar2) { #a bunch of follow on code that works if the second foreach and if sta +tements are removed

    I'm just not sure which direction I should go with trying to limit the list it chooses to evaluate, without limiting the list of sequences it uses to evaluate against. I have tried several combinations of foreach/if/where statements and the closest I have gotten lead me to loop through the entire first table, but only using one sequence from the second table. I couldn't get it to iterate through the "filter" table. I'm sure my explanation is lacking severely.

match digit, followed by hyphen, followed again by digit - then add whitespaces and replace in file
4 direct replies — Read more / Contribute
by fasoli
on Aug 17, 2017 at 08:48

    Hi Wise Monks!

    I've been really confused about a problem I'm having with a file. It's a text file, with 4 columns, and with a few thousand lines. The contents are numbers that look like this

    1.234 5.6789 -1.235

    Those files occur as outputs from a software. The problem is that in some cases the contents look like this

    1.234 5.6789-12.235

    *notice the number of the last column: because now there are 2 numbers before the decimal point, the number gets stuck on the second column.

    Naturally now I'm having trouble plotting this file. So I'm trying to match strings where there is a digit, followed by a hyphen, followed by another digit, and then I want to replace this -hopefully correctly- with an added whitespace so that the numbers are correct.

    I'm trying this and the regex match works, it does print the problematic bits:.

    #!/usr/bin/perl use warnings; use strict; my $test; open my $INPUT, '<', "file.txt" or die $!; while (<$INPUT>) { chomp $_; if ($_=~/(\d)(-)(\d)/) { print "$1$2$3 \n"; } }

    But now I'm stuck: how do I complete the replace action? And how do I print the new contents of the file? I haven't succeeded in anything more than compilation errors. In terms of replacing, I've tried this

       if ($_=~s/(\d)(-)(\d)/(\d)    (-)(\d)/) {  

    (supposedly telling the script to add spaces between the digit before the hyphen and the hyphen itself)

    but I get this error

    Unrecognized escape \d passed through

    Then I tried it with the $1$2$3 but again it was wrong. Can you give me any hints about how to make the replace function work?? Thank you so much!

Error 500 in LWP
1 direct reply — Read more / Contribute
by YarNik
on Aug 17, 2017 at 06:25
    Hello! I'm trying to get a https page, half of the domains is OK. But with the other half I get the error:

    500 Can not connect to domen: 443 (connect: Network is unreachable); Client-Warning: Internal response

    The script is standard, I tried to change the agent and different versions of ssl_opts:
    use LWP::UserAgent; $ua = LWP::UserAgent->new( # agent => 'Mozilla/5.0 (X11; U; Linux i686 +; en-US; rv:1.9.0.5) Gecko/2008120121 Firefox/3.0.5', # ssl_opts => { verify_hostname => 0, SSL_verify_mode => 0, + SSL_verifycn_scheme => 'none' }, ); $response = $ua->head("$get_url"); print $response->dump();
    P.s. domain example microsoft.com, google.com ( bing - it is OK. )
Reusing Compiled Perl or Opcode for Apache Server
3 direct replies — Read more / Contribute
by mlodato
on Aug 15, 2017 at 20:36

    O wise ones, I have come to you in humility to ask a question for which I have little surrounding knowledge. Please take pity on me and ask for clarification so I can seek information to bring back to you.

    I work on a project that has a Perl back end behind an Apache server. The development servers are very slow. For certain production-like servers, we precache our static content and preload our Perl modules. Doing this takes a long time. It would be nice if it didn't take so long a second time if the Perl code hasn't changed.

    I was wondering - is there was a way to preload all of the Perl modules once and then serialize it in some way to be read in more quickly a second time?

    Note that I don't yet know exactly what "preloading Perl modules" means, but I am actively looking into it and maybe you don't need that information to answer the question because preloading is a common term.

    I have seen several posts saying that compiling Perl into C-like code is not yet a thing. That's fine, I'm not looking to optimize or hide the code. I have seen several posts saying that I can generate an executable with PAR::Packer. Maybe this can be used? I have seen several posts saying that Perl is first parsed into opcode before being run. I'm not sure if this is just for Perl 6, but if it's for Perl 5, I see no reason for that opcode to not be reusable...right? I have seen a post explaining that Perl can't be parsed. I find this confusing.

    Edit: After some digging it looks to my untrained eyes like "preloading" just calls use, load_class from Class::Load, and ->new for each module

sed command with variable in perl
3 direct replies — Read more / Contribute
by samira_saber
on Aug 14, 2017 at 15:38
    I have a problem with the sed command in perl system( q {sed -i — "s/SOL..............*/SOL $sol1/g" topol1.top}); this is the command that i have. I know that i should use double coat and backslash for the variable to be run. But it cant be run and if it is the variable cant be printed. How should I use it?
can't open file for appending
2 direct replies — Read more / Contribute
by ytjPerl
on Aug 14, 2017 at 11:57
    Hi folks, I have code as follow to start up my server and output log to a file. I've tested and it was working. but Today when I tried to run it again, I got error 'Can't open 'D:/log_script/tuxedo_logs/startup.20170814xxxxxx.log' for appending: 'No such file or directory. I am really confused, I assume 'my $input = "D:/log_script/tuxedo_logs/startup" . DATETIME . ".log";' this code would generate this file for writing.
    use strict; use warnings; use lib "D:/App/Perl/lib//"; use autodie; use Capture::Tiny 'capture_merged'; use POSIX; use constant DATETIME => strftime("%Y%m%d%H%M%S", localtime); my $input = "D:/log_script/tuxedo_logs/startup" . DATETIME . ".log"; open ( my $file, ">>", $input )or die "cannot open $!"; chdir "D:/server/setup"; print $file capture_merged { system('setenv.cmd&&tmboot -y') }; close($file); `
Cant locate object method CAM:PDF. I'm doing something dumb
1 direct reply — Read more / Contribute
by jorba
on Aug 14, 2017 at 08:18
    I cribbed some code from the internet to extract data from a pdf using CAM:PDF. It works fine. I then adapted it as part of a larger program. That doesn't work. So I'm doing something dumb. Appreciate it if someone could point out what it is.

    Running on Windows.

    Here's the cribbed code. It works fine, printing the data to the console.

    use strict; use warnings; use CAM::PDF; use LWP::UserAgent; my $pdf_filename = 'C:\Users\Jay\Desktop\SBS DEV\test.pdf'; convert_pdf_to_text(); sub convert_pdf_to_text { use CAM::PDF::PageText; my $pdf_filename = 'C:\Users\Jay\Desktop\SBS DEV\test.pdf'; my $pdf = CAM::PDF->new($pdf_filename); my $y = $pdf->getPageContentTree(1); print CAM::PDF::PageText->render($y); }

    Here's my code in full. The relevant bit is the line print CAM::PDF::PageText->render($content);

    use strict; use warnings; use DBI; use CAM::PDF; my $db; my $sql; my $src; my $tgt; my $file; my $cnt; my @row; sub ConvertPDFToText { my $infn; my $fh; my $pdf; my $content; $infn = "$_&#91;0&#93;\\$_&#91;2&#93;"; open($fh, '>',"$_&#91;1&#93;" . "\\" . "Archive.txt"); print "filename $infn\n"; print "xx\n"; $pdf = CAM::PDF->new($infn); $content = $pdf->getPageContentTree(1); print CAM::PDF::PageText->render($content); return ""; } #Get db handle; $db = DBI->connect('DBI:mysql:SBS_Dev', 'DBProcess','ThhuSd73MIWAW +aY6') or die 'Cant Connect to DB'; # Get file directories $sql = $db->prepare('SELECT SRC_DIR, TGT_DIR FROM EXP_EXTRACT_CNTL + WHERE ID = 1') or die 'Couldnt run cntl sql: '. $db->errstr; $sql->execute(); @row = $sql->fetchrow_array(); ($src, $tgt) = @row; print "source $src\n"; print "target $tgt\n"; if ($sql->rows == 0) { die 'Control info not found'; } #Process Files from Source Directory opendir(DIR, $src) or die "Cant open Dir: $!"; while (($file = readdir(DIR))) { if ($file ne '.' and $file ne '..' and $file ne "Archive") { print "file $file\n"; #get data out of file ConvertPDFToText($src, $tgt, $file); $cnt = $cnt + 1; # Move file to archive rename "$src\\$file" => "$tgt\\$file"; } } closedir(DIR); print '$cnt files processed\n';

    Here's the output from running the second one

    C:\Users\Jay\Desktop\SBS DEV\CODE\perl&gt;.\sbsextractfrompdf.pl source C:\Users\Jay\Desktop\SBS DEV\Data\Receipts target C:\Users\Jay\Desktop\SBS DEV\Data\Extracted file home depot large 2.pdf filename C:\Users\Jay\Desktop\SBS DEV\Data\Receipts\home depot large 2 +.pdf xx Can't locate object method "render" via package "CAM::PDF::PageText" a +t C:\Users \Jay\Desktop\SBS DEV\CODE\perl\SBSExtractFromPDF.pl line 31. C:\Users\Jay\Desktop\SBS DEV\CODE\perl&gt;

    As far as I can see, the relevant lines of code are identical as are the lines needed to get there. So what am I missing?

    Thanx J.
New Meditations
A Few Impressions from Amsterdam
3 direct replies — Read more / Contribute
by haukex
on Aug 13, 2017 at 11:03

    I was originally going to post something else for my 1000th node, but I'll save that for later, since I think this is fitting: As many of you probably know, The Perl Conference in Amsterdam ended on Friday. It was my first Perl event, and a great experience! I was very happy to finally meet some of you in person, choroba, LanX, Corion, Tux, Laurent_R, and rurban, and I'm really sorry I didn't get to say bye properly since I had to leave a bit early. If I met some of you but haven't yet matched you to a username, I apologize and drop me a /msg.

    I enjoyed the talks by some of the greats like TimToady, TheDamian, Ovid, and brian_d_foy, some of which are already available as videos on Facebook (Update: and YouTube, thanks Corion), and I hear the full videos should be online within a month or so. For my favorite funny moment of the conference: First, watch Damian Conway's talk "Three Little Words", definitely worth it on its own (as is checking out the impressive PPR), and then go to the Lighting Talks from Aug 10th and skip ahead to around 1h39m15s in the video... :-)

    Update: Added direct links to the YouTube videos.

    Update 2: Some pictures can be found at http://twitter.com/TPCiA. Also updated links to YouTube.

How has Perl affected you?
4 direct replies — Read more / Contribute
by stevieb
on Aug 12, 2017 at 16:58

    Slow weekend afternoon, taking a break from packing up my life and doing a huge shift towards an entirely new adventure.

    I ran into Perl through my first non-contract job. I picked up an ISP that was barely more than a start-up, and with a book off of a shelf, I fell in love (Perl 4/early 5 days).

    I have come to appreciate the Perl community as a whole as a group who are loyal, dedicated and serious, all the while being able to take criticism quite well.

    I savored the day I became a Friar; it allowed me to take part in some decision making on this site, which imho is the de-facto place to find Perl experts.

    I've gone on to do a lot of interesting things, meet a lot of interesting people and help a lot of people in this language (and thanks to it, other ones as well).

    I'm coming up on my 9th birthday here, so while taking a breather from the physical duties of life, thought I'd once again share my appreciation for Perlmonks, and ask you, newbie or not, why you are invested in Perl, what it has done for you, and whether it has changed anything regarding how you approach other tasks/problems in your day-to-day.

    -stevieb

New Cool Uses for Perl
How RPi::WiringPi suite is automagically unit tested
1 direct reply — Read more / Contribute
by stevieb
on Aug 17, 2017 at 20:57

    A while ago, we were talking about my desire to write a tutorial about "Perl and Raspberry Pi". To kick it off, I thought I'd write a blog post covering some of the aspects of how I ensure full automatic unit test coverage of the software, and its core functionality.

    I posted it over on my blog, so for now, I'm just going to link to it as it's just a one-off that I quickly put together. If anyone is interested in how this software is tested, have a look. If you have feedback, all the better. Questions? That's the best I could ask for.

    How RPi::WiringPi distribution gets tested

    -stevieb

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (4)
As of 2017-08-19 20:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Who is your favorite scientist and why?



























    Results (312 votes). Check out past polls.

    Notices?