Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
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.

Quests
poll ideas quest 2020
Starts at: Jan 01, 2020 at 00:00
Ends at: Dec 31, 2020 at 23:59
Current Status: Active
5 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.

Supplications
Database connection issue with SQL server cluster
2 direct replies — Read more / Contribute
by sophate
on Feb 27, 2020 at 21:52

    Hi,

    I am using DBI(v1.642) and DBD-Sybase-freetds(v1.08) to connect to a SQL server cluster. The connection fails randomly. After some investigation, I find the DB hostname is resolved to two IP addresses by a DNS server. Only one IP address is working and the other IP is not working. This causes the DB connection to fail randomly. Here is the DB connection error message.

    err: 41 sev: 78 state: 0 line: 0 server: not available proc: not available msg: Server is unavailable or does not exist. sql: not available err_type: client

    Here are the DB connection codes.

    $ENV{'TDSVER'} = '7.0'; my $DBhandle = DBI->connect( "DBI:Sybase:host=$Hostname;port=$Port;dat +abase=$DBName", "$UserID", "$Pwd", { syb_err_handler => \&SybaseError +Handle } );

    Any idea how to deal with hostname that returns multiple IP addresses but only one is ACTIVE with DBI?

... something in the environment?
5 direct replies — Read more / Contribute
by chexmix
on Feb 27, 2020 at 15:22
    Hi Monks,

    I'm tearing my hair out over a problem, and I'd appreciate any guidance or pointers.

    I worked very hard on an update to a script we use at work. My update involved using stored procedures instead of direct database (Sybase) queries. This way I could call the stored procedures and get back values identified as output params.

    The construct looks like this:

    my ( $thing_id, $action ); my $update_or_insert = $dbh1->prepare( qq/exec stored_procedure / . qq/\@p1 = ?, \@p2 = ?, \@p3 = ?, \@p4 = ?, \@p5 = ?, / . qq/\@p6 = ?, \@p7 = ?, \@p8 = ?, \@p9 = ?, / . qq/\@thing_id = ? output, \@action = ? output/); $update_or_insert->bind_param(1, $p1, SQL_INTEGER); $update_or_insert->bind_param(2, $p2, SQL_INTEGER); $update_or_insert->bind_param(3, $p3, SQL_INTEGER); $update_or_insert->bind_param(4, $p4, SQL_VARCHAR); $update_or_insert->bind_param(5, $p5, SQL_DATETIME); $update_or_insert->bind_param(6, $p6, SQL_VARCHAR); $update_or_insert->bind_param(7, $p7, SQL_VARCHAR); $update_or_insert->bind_param(8, $p8, SQL_VARCHAR); $update_or_insert->bind_param(9, $p9, SQL_VARCHAR); $update_or_insert->bind_param(10, $thing_id, SQL_INTEGER); $update_or_insert->bind_param(11, $action, SQL_VARCHAR ); $update_or_insert->execute(); ( $thing_id, $action ) = $update_or_insert->syb_output_params(); $update_or_insert->finish;

    I got this working flawlessly in testing. But now I am running it in our 'shadow test' environment and am getting uninitialized value complaints for the bind_param statements for $thing_id and $action. Ultimately the script fails.

    These were just as unitialized in my tests, but those runs didn't complain and they ran to completion.

    To be fair, the input files to the program have changed some and have additional lines -- these new lines are skipped by default anyway, but I added a line of code to do it exolicitly.

    I did figure out that our shadow test environment was running a different version of Perl. I fixed this: both are running 5.22.2, which is what I ran in my tests and what we run in production. This didn't help.

    I confirmed that the same version of DBD::Sybase is being run in both places.

    Is there something that could cause this that I am failing to consider? I asked our dba whether it could be Sybase-related but he said no.

    Very tired. I could figure something out after I post this, but ...

    Thanks,

    Glenn

Getiing keys or values of a file based hash
3 direct replies — Read more / Contribute
by shabird
on Feb 27, 2020 at 12:56

    I have a file named "gene.txt", which looks like this GeneName GeneType

    APOL4 protein_coding CYP2C8 protein_coding NAALADL2 protein_coding NANOS3 protein_coding C20orf204 protein_coding MIR429 miRNA MIR200A miRNA MIR200B miRNA I have a file named "gene.txt", which looks like this GeneName GeneType APOL4 protein_coding CYP2C8 protein_coding NAALADL2 protein_coding NANOS3 protein_coding C20orf204 protein_coding MIR429 miRNA MIR200A miRNA MIR200B miRNA
    i have read that file in perl and assigned the values to a hash. Now i want to get the keys or values from that file as i have assigned it to hash but i am unable to get those. my point is to i want to get keys by using the keys() method but its not printing the values on the left as keys and its not printing anything i don't know why i will be very thankful if anyone could help me. Thank you in advance.

    #!/usr/bin/perl -w use strict; open FILE1, "/Desktop/gene.txt" or die; my %hash; while (my $line=<FILE1>) { chomp $line; # print $line,"\n"; (my $word1,my $word2) = split /:/, $line; $hash{$word1} = $word2; } # Print hash for testinf purposes while ( my ($k,$v) = each %hash ) { # print "Key $k $v\n"; @keys = keys(%hash); print @keys; }
Where to go to discuss a Perl module, as in "Why do I want to use this?"
5 direct replies — Read more / Contribute
by davebaker
on Feb 27, 2020 at 09:32

    Wondering where is a good place to go to discuss a Perl module, as in "Why do I want to use this? What does it do that's better than existing solutions/modules?"

    The Synopsis often doesn't give me an example that adequately answers that question. It often assumes I know exactly why I'd want to use the module, and why it's better than other modules or hand-coded solutions (if any).

    For example, https://metacpan.org/release/App-unbelievable -- I understand the benefit of static file sites, and I have written some apps in Dancer2, but I am wondering how and why one would convert data in a database (which my Dancer2 app uses to produce HTML displays) into the markdown files that are used as input to the CPAN module. Is that how and why one would use it? Is it better than other static site generating modules?

    Perhaps that particular question is dumb, but it's a sincere one, and yet it's one that I feel uncomfortable lobbing into Seekers of Perl Wisdom. So the generic question here (not so much the App-unbelievable question above, which is just an example) is, do the monks (or do other parts of the Perl ecosystem) have a more appropriate place?

    I've been a Perl enthusiast for 20 years, but I'm not a professional developer. Thanks for your advice!

Close script with open system call
5 direct replies — Read more / Contribute
by Phweda
on Feb 27, 2020 at 07:24

    Script ends when it opens its logfile by a call to 'system'. Even with explicit 'exit' the script keeps running. Assume it is waiting for the system call to terminate? In this case want to force the script to terminate.

    my $logFileName = $rootDIR . "/fmlog.txt"; open $OUTPUTFILE, "> $logFileName" or die "Died trying to open the out +put file $!"; # Processing files and logging results close ($OUTPUTFILE); # Open Log file for user system($logFileName); exit;
    Script stays open until text application is closed or until a ctrl-c Thanks Phweda
Regular Expression to Parse Data from a PDF
5 direct replies — Read more / Contribute
by kevyt
on Feb 27, 2020 at 01:13

    I have not been able to parse a few fields from a pdf file with CAM::PDF or regular expressions. Can someone offer help on how I may accomplish the task?

    I noticed that CAM::PDF changes $100 to $ 100.

    I was not able to split on \n so I split the line on the Id number in the far right column.
    The column AWD is the company that won.

    I would like to capture all of the columns except comments.

    Here are two Example files:

    https://contractorconnection.gpo.gov/abstract/746810

    https://contractorconnection.gpo.gov/abstract/746819

    Thanks

    Kevin

    #!/usr/bin/perl -w use warnings; use strict; use CAM::PDF; use LWP::Simple; my @ns_headers = ( 'User-Agent' => 'Mozilla/4.76 [en] (Win98; U)', 'Accept' => 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*', 'Accept-Charset' => 'iso-8859-1,*,utf-8', 'Accept-Language' => 'en-US', ); my $jacket_id = 746810; my $ua = LWP::UserAgent->new; # $ua->timeout(5); # Is the site available? my $response = $ua->get('https://contractorconnection.gpo.gov/abstract +/'. $jacket_id , @ns_headers); my $pdf = CAM::PDF->new($response->content) || die "$CAM::PDF::errstr\ +n"; # my $pdf = CAM::PDF->new('C:\dev\perl\file.pdf') || die "$CAM::PDF::e +rrstr\n"; # print $pdf->toString(); for my $page (1..$pdf->numPages){ my $text = $pdf->getPageText($page); my @lines = split (/$jacket_id\s+/, $text); # split on Jacket ID a +nd a space foreach (@lines) { print "\n$_\n"; if ( /^A/ ) { # A at the beginning of a line is the Award winn +er print $1; } if (/^(\d+\-)(\d+)/) { # Contractor Code print"Contractor code ". $1,$2 ."\n"; } if (/(\w+)\s+\$/ ) { # Does not work print"Name ". $1 ."\n"; # Name } # if (/\$?([0-9]{1,3},([0-9]{3},)*[0-9]{3}|[0-9]+)(\.[0-9][0-9] +)?$)/) { # Does not work # print"Amount ". $1 ."\n"; # Amount # } # if(1){ # Date # print "Date " . $1; # } } }
count multiple variables in a single array.
3 direct replies — Read more / Contribute
by flieckster
on Feb 26, 2020 at 14:42
    I have a script that goes into a folder on our server, glob's all the files in it, and sends an email to me with exactly what clients files might be in that folder. the files in that folder all have elements in the filenames that i can match to an expression to identify each clients files. i would like to glob the files, then look at the files in the array and match to a list of possible matches and report back to me which client files its found. as you can see with my code below i can match with individual if statements, then list them all out in my email, but that seems wrong, plus i'd rather not have any of the "0" counts show up.
    1 TUMI files 0 BW files 0 maurices files
    ideally i'd list the files in one email like such. any help in modifying my code to be more scaliabe would be helpful.
    1 TUMI file TUMI-1354839054_alt1 1.psd 2 maurices files maur-1111.psd maur-1110.psd
    code below::
    #!/usr/bin/perl -w use Net::FTP; use File::Copy; use File::Basename; use Email::Send::SMTP::Gmail; use POSIX qw(strftime); my $date = strftime("%m-%d-%y",localtime); my $time = strftime("%I:%M:%S",localtime); my $photo_error_folder = "/Volumes/photorepos/Partners/WorkHorse/ERROR +/PhotographyDrop_ERROR"; my $post_error_folder = "/Volumes/photorepos/Partners/WorkHorse/ERROR/ +PostDrop_ERROR"; my $subject = "ICS -- Files in the Error Folder "; my $dllist ='bflieck@xxx.com'; chdir( $photo_error_folder ) or print "Cant chdir to $photo_error_fold +er $!"; my $count = (@photo_err_list) = glob '"*{jpg,tif,tiff,psd}"'; if ($count > 0) { my ($mail,$error)=Email::Send::SMTP::Gmail->new( -smtp=>'smtp.gmail.co +m', -login=>'kopautomatio +n1@xxx.com', -pass=>'xxx', -layer=> 'ssl', -port=> '465', -debug=> 1, -timeout=> 1000); $tumi_count = grep { /TUMI/ } @photo_err_list; if ($tumi_count > 0) { print "$tumi_count TUMI files\n"; } else { print "$tumi_count TUMI files\n"; } $bw_count = grep { /BW/ } @photo_err_list; if ($bw_count > 0) { print "$bw_count BW files\n"; } else { print "$bw_count BW files\n"; } $maurices_count = grep { /Maur/ } @photo_err_list; if ($maurices_count > 0) { print "$maurices_count Maurices files\n"; } else { print "$maurices_count maurices files\n"; } my $body="please fix and redrop or delete the<br> file://$photo_error_folder/<br><br> "; my $spacer ="<br>"; my $body1= join "<br>\n", @photo_err_list; $mail->send(-to=>"$dllist", -from=>"$dllist", -subject=>"$subject", -b +ody=>"$body $spacer $body1", -contenttype=>"text/html"); $mail->bye; }
Capturing errors from backtick
3 direct replies — Read more / Contribute
by cormanaz
on Feb 26, 2020 at 10:39
    I am using backticks to run a Python script from the command line. It retrieves the publication date from html pages (if you're interested in that script see here): my $result = `htmldate -u $url`; When htmldate can't access the url, it writes an error to output # ERROR no valid result for url: and I'm wondering if there is a way to trap this error. The FAQ says "Backticks and open() read only the STDOUT of your command." I assume this means it assigns only the stdout output to $result in the above command, and it is writing the error message to whatever output is designated for stderr. Is there some way to detect this, short of redirecting stderr to a file, then opening, reading, and closing this every time I call htmldate?
Detecting whether UV fits into an NV
6 direct replies — Read more / Contribute
by syphilis
on Feb 25, 2020 at 20:26
    Hi,

    I was initially going to mark this post as off-topic ... still not entirely sure whether I should have ....
    The question relates specifically to perls for which both $Config{ivsize} and $Config{nvsize} are both 8. That is, perl's integer type (UV/IV) is 64-bit, and perl's floating point type (NV) is either a double or an 8-byte long double.

    The aim is to determine whether a given integer value can be represented exactly as a double.
    Clearly, any integer <= 9007199254740992 can be represented exactly as a double. (9007199254740992 == 2 ** 53.)
    In addition to those values, however, any integer whose highest set bit and lowest set bit are separated by 51 or fewer bits is also exactly representable as a double.

    Here follows my solution. The question is "Is there a better way ?".
    Assume that the given arg is an integer in the range 0 .. 18446744073709551615 (with 18446744073709551615 being the largest possible UV value).
    As an XSub:
    int uv_fits_double(UV arg) { if(arg < 9007199254740993) return 1; while(!(arg & 1)) { arg >>= 1; if(arg < 9007199254740993) return 1; } return 0; }
    And as perl sub:
    sub uv_fits_double { my $arg = shift; return 1 if $arg < 9007199254740993; while(!($arg & 1)) { $arg >>= 1; return 1 if $arg < 9007199254740993; } return 0; }
    It annoys me that I can't find a way to detect and shift all of the trailing zero bits off in one hit - and that I instead have to detect and shift them off one at a time.
    The number of times that the "$arg < 9007199254740993" comparison is evaluated also annoys me. (Doing that evaluation inside the while loop means that the while loop will perform a maximum of 11 cycles. Without that evaluation it could perform up to 63 cycles.)

    As I understand it, the only thing I need to determine is "Are there more than 51 bits between the highest set bit and the lowest set bit ?", and I do that by shifting off all trailing unset bits so that I can then determine (by examining the remaining value) whether it fits into 53 bits or not.
    It feels like there ought to be a quicker, simpler way of doing it ... but I don't see one.
    A perl demo of the uv_fits_double sub:
    use strict; use warnings; use Config; die "This script not meant for this perl configuration" unless $Config{ivsize} == $Config{nvsize}; # The integer value 2251799813685249 is # representable exactly as a double. # Therefore 2251799813685249 * (2 ** 10) # is exactly representable as a double, # since 10 is well within the allowable # exponent range. # 2251799813685249 * (2 ** 10) is also # within the bounds of allowable integer # values. my $fits_d = 2305843009213694976; # 2251799813685249 * (2 ** 10) my $no_fits_d = $fits_d + (2 ** 6); print uv_fits_double(2251799813685249); # fits print uv_fits_double($fits_d); # fits print uv_fits_double($no_fits_d); # doesn't fit print uv_fits_double($fits_d + (2 ** 15)); # fits print "\n"; sub uv_fits_double { my $arg = shift; return 1 if $arg < 9007199254740993; while(!($arg & 1)) { $arg >>= 1; return 1 if $arg < 9007199254740993; } return 0; } __END__ Should output 1101 The 4th value fits, even though it's greater than the 3rd value (which doesn't fit).
    Cheers,
    Rob
reading input into a number of arrays
4 direct replies — Read more / Contribute
by Dannypje
on Feb 25, 2020 at 10:57
    Hi,

    probably the code below is not the best way to do it, but it's something I understand (or at least I thought I understood). Intention is to read 3 lines of characters (say 1111111, 2222222, 3333333) and store them in a 2 dimensional array $a(1,1) through $a(3,7) (I know, I know, I should start from 0, but I don't think that's the issue).
    The thing is, when I print the array inside the loop, I nicely get 1111111, 2222222, 3333333 as output. However, when I try to print outside the loop, I get 3 times my last input (3333333, 3333333, 3333333).
    I don't understand how this happens. Please enlighten me.
    TIA
    Please note, the square brackets around the indices were lost in translation somewhere, the syntax is hence not the problem.

    for ($i=1;$i<=3;$i++) { $ingang=<>; chomp $ingang; ($a[$i,1],$a[$i,2],$a[$i,3],$a[$i,4],$a[$i,5],$a[$i,6],$a[$i,7])=spl +it('',$ingang); } print "Resultaat\n"; for ($p=1;$p<=3;$p++) { for ($j=1;$j<=7;$j++) { print $a[$p,$j]; } print "\n"; }

    Node formatting cleaned up by GrandFather

ne vs. ! eq
2 direct replies — Read more / Contribute
by boerni
on Feb 25, 2020 at 08:34
    Hey Monks I never realized perl behaves like this. There is a difference between (! 'a' eq 'b') and ('a' ne 'b').
    #!perl use strict; use warnings; use Data::Dumper; my $s1 = 'bla'; my $s2 = 'blu'; my $r = $s1 eq $s2; print Dumper $r; if (! $s1 eq $s2) { print "$s1 and $s2 are not the same\n"; } else { print "$s1 and $s2 are the same\n"; } exit 0;
    prints:
    $VAR1 = ''; bla and blu are the same

    The "correct" ($s1 ne $s2) works as expected. But why does (! $s1 eq $s2) not work?

    Probably there is a simple explanation but I don't know it... Maybe one of you Monks can explain this.

    Thank you

Comments regex
2 direct replies — Read more / Contribute
by kepler
on Feb 25, 2020 at 04:45

    Hi

    I'm trying to make a simple perl code that reads a code file and removes all comments (javascript style), like //... or /*... */ and /*....new line (number of time unknown)

    Can someone give me an hand? Removing patterns like // or /*...*/ can be done, I think, with /\/+\*?\.*/gi but there are weird things on a random code. For instance, line breaks or the lines beginning with spaces or tabs. So I could do /([\ |\t]*)\/+\*?\.*/gi perhaps

    Best regards

Cool Uses for Perl
Announcing Perl-based automation of Notepad++
1 direct reply — Read more / Contribute
by pryrt
on Feb 22, 2020 at 14:35

    At long last, I have a version of my Perl module for automating Notepad++ (the Windows-based text editor) that Iíve been willing to publish.


    NAME

    Win32::Mechanize::NotepadPlusPlus - Automate the Windows application Notepad++

    SYNOPSIS

    use Win32::Mechanize::NotepadPlusPlus ':main'; my $npp = notepad(); # main application

    DESCRIPTION

    Automate the Windows application Notepad++. This is inspired by the Notepad++ plugin PythonScript, but I decided to automate the application from the outside, rather than from inside a Notepad++ plugin. But this module uses similar naming conventions and interface to the PythonScript plugin.

    LIMITATIONS

    This is the first public release of the module. In general, it works. As with all first releases, there is room for improvement; I welcome feedback.

    The first known limitation is that none of the hooks for Scintilla or Notepad++ callbacks have been enabled. That may come sometime in the future.

    All the testing and development was done with a US-English installation of Notepad++, and all the file encodings have been ANSI or UTF-8. I know that I need to include better tests for encoding, and any help you can provide with that is appreciated.

    Notepad++ is a Windows application, so that's the intended platform for this module. However, I know Notepad++ can be made to run in Wine and similar environments in Linux, so it may be possible to make this module drive Notepad++ in such an environment. Feedback on this process is welcome.

    INSTALLATION

    To install this module, use your favorite CPAN client.

    For a manual install, type the following:

    perl Makefile.PL make make test make install

    (You may need to use "dmake" or "gmake" instead of "make", depending on your setup.)

    AUTHOR

    Peter C. Jones

    Please report any bugs or feature requests thru the repository's interface at https://github.com/pryrt/Win32-Mechanize-NotepadPlusPlus/issues, or by emailing <bug-Win32-Mechanize-NotepadPlusPlus AT rt.cpan.org> or thru the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Win32-Mechanize-NotepadPlusPlus.

    COPYRIGHT

    Copyright (C) 2019,2020 Peter C. Jones

    LICENSE

    This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (5)
As of 2020-02-28 15:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What numbers are you going to focus on primarily in 2020?










    Results (124 votes). Check out past polls.

    Notices?