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
Useless use of string in return statement
4 direct replies — Read more / Contribute
by Bod
on Apr 12, 2021 at 19:06

    Is there something strange about the way return treats conditions?

    I have this and it doesn't work as expected...

    sub get_ids { my ($self, %attrs) = @_; # Do stuff... my %result; # $result{'message'} = ''; if ($self->{'error'}) { $result{'status'} = 'error'; $result{'message'} = $self->{'error'}; } else { $result{'status'} = 'success'; $result{'api-key'} = $self->{'api-public'}; $result{'session'} = $intent_id; } return encode_json(\%result) if lc($attrs{'format'}) eq 'json'; return $result{'message'} or "$result{'api-key'}:$result{'session' +}"; # <- line 229 return "SOMETHING"; }
    If it is called as get_ids( 'format' => 'json' ); it works fine but asking it to return a text string returns undef and warns Useless use of string in void context at line 229. The way I think it should work is that if $result{'message'} evaluates as true, that will get returned but if it evaluates as false then "$result{'api-key'}:$result{'session'}" wil be returned instead.

    Can you explain why this is not behaving as expected?

    As an aside, in searching for an answer I found this post -> Useless use of string in void context
    There it is suggested that Perl reports the wrong line number for this warning so it is quite possible that I'm actually looking in the wrong place!

Strange behavior in File::Find (stopped working for no reason)
2 direct replies — Read more / Contribute
by pvaldes
on Apr 12, 2021 at 12:40

    I'm perplexed. Can you tell me what is wrong with this script?

    #!/usr/bin/perl -w use strict; use warnings; use diagnostics; use File::Find; open (my $t, '>', '/home/myuser/myfilename.sql') or die $!; print $t "blah blah\n"; find( { preprocess => \&hi, wanted => \&work, postprocess => \&bye, fo +llow_skip => 1 }, "."); sub hi { print $t "hi\n"; return;} # works correctly sub bye { print $t "bye\n"; return;} # works correctly sub work { print "my name is: ", $File::Find::name; print $t "I'm a file!"; return;} close $t;

    when I run the script in the current tree directory I would expect a list of filenames being printed in screen and a text file containing:

    blah blah hi I'm a file!I'm a file!I'm a file!... etc bye

    But what I have is: "my name is: ." or "my name is: 1" and a file containing:

    blah blah hi bye I'm a file! <-yep, solitary and in the wrong position

    libfile-find-wanted-perl/testing,testing,now 1.00-1.1 all installed, automatic

    Can somebody tell me what is happening here? Is not a little late for an 1-April Joke?

LinkedIn module
1 direct reply — Read more / Contribute
by Bod
on Apr 12, 2021 at 08:07

    Searching CPAN I was rather surprised that the only general modules for connecting to LinkedIn seem to be WWW::LinkedIn and Net::Linkedin::OAuth2 - both of these date from before Microsoft acquired LinkedIn 5 years ago...unbelievable that it is that long ago!

    Since the 5th April, Hootsuite have reduced the number of scheduled posts permitted on free accounts down to just 5 and we don't use the other features to warrant the paid price tag. We already have an automated Twitter scheduler and I want to add LinkedIn to it so just need something to authenticate, read the timestamp of the latest post and be able to create a post containing media.

    Before I write something to do this, are there any modules available or should I try out the modules above despite their age?

Pushing hash ref onto array ref
2 direct replies — Read more / Contribute
by Bod
on Apr 11, 2021 at 18:18

    A module I am creating has a blessed hash ref as is common. One of the hashes is a reference to an array of anonymous hashes created like so:

    sub new { my $class = shift; my %attrs = @_; my @products = ({ 'id' => 0, 'name' => 'Test', 'description' => 'Some test data', 'qty' => 1, 'price' => 1000, }); $attrs{'trolley'} = \@products; return bless \%attrs, $class; }
    Later on I want to push another anonymous hash onto @products.

    What is the best way to do this?
    Both of these push lines appear to work identically in testing

    sub add_product { my ($self, $product_data) = @_; # create $new_product hasfref push $self->{'trolley'}, $new_product; push @{$self->{'trolley'}}, $new_product; }
    However, I suspect there is some subtle difference between the two which might trip me up in the future!

    Is there a practical difference and is there a 'best' option to use?

Check for another program availability
10 direct replies — Read more / Contribute
by hrcerq
on Apr 10, 2021 at 16:06

    Hi. I need feedback on this... In order to run a Perl program, I must check for the availability of another program (i.e. it's in the PATH). So I've created a subroutine for this (which returns 0 for "not found" and 1 for "found"), and I'm not sure if this is the best option. Here's the code:

    sub available { my $program = shift; for my $pathdir (split /:/, $ENV{PATH}) { return 1 if -x "$pathdir/$program"; } return 0; }

    I'd like to know if it's inefficient, and if there's a core module that already takes care of such tasks. Found nothing related on the FAQs.

pp generated executable can't find or load libraries
4 direct replies — Read more / Contribute
by vexed
on Apr 10, 2021 at 11:21

    Good day Monks,

    I hope you are all well. I am very novice Perl user, in fact I have only used sendEmail.exe by Brandon Zehm, which is a packed Windows executable based on Perl.

    That specific version of sendEmail is old and only supports TLSv1.0

    I have found an updated Perl script patched to used TLSv1.2.

    I have used Par::Packer (installed via cpan)to pack this updated Perl script into an executable, but no matter what I do, the executable keeps asking for Net::SSLeay and IO::Socket::SSL if Perl is not installed. (It works fine if Perl is installed or if I run the .pl script)

    Below is the error message from sendEmail.

    sendEmail.exe: ERROR => No TLS support! SendEmail can't load required libraries. (try installing Net::SSLeay and IO::Socket::SSL)

    Things that I tried:

  • I have used pp with -M Net::SSLeay -M IO::Socket::SSL.
  • I have installed Strawberry Perl 32 bit and 64 bit. (v5.32.1.1)
  • I have used Perl Portable instead. (v5.32.1.1)
  • I have used an older version of Perl. (v5.26.3.1 32 bit Portable)
  • I have made sure the needed packages are installed and up to date.
  • I have tried to use Dependency Walker, but it seems to hang on my workstation (Windows 10 20H2 x64).
  • pp -x fails with this error message: SYSTEM ERROR in executing : 256 at C:/Perl/perl/site/lib/Module/ line 1503.
  • I do not understand why the generated executable is not finding or loading the required libraries.

    Any help is greatly appreciated.

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)

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 perusing the Monastery: (5)
    As of 2021-04-13 05:35 GMT
    Find Nodes?
      Voting Booth?

      No recent polls found