Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

Seekers of Perl Wisdom

( [id://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
Tk Entry widget confusion
2 direct replies — Read more / Contribute
by colintu
on Jul 12, 2024 at 05:56

    I have an Entry widget where the textvariable is initialised as a numeric before the widget is created. The widget and validate routine looks like:

    my @c_speed = (5, 8, 12, 8); my $cs_e1 = $seg1_f->Entry(-textvariable => \$c_speed[0], -width => +4, -validate => 'all', -vcmd => \&validate_speed, -font => $med_font)->grid( -row => 0, -column => 1, -sticky => "w"); sub validate_speed{ my $val = shift; $val ||= 0; #get alphas and punctuation out if( $val !~ /^\d+$/ ){ return 0 } if (($val >= 0) and ($val <= 20)) {return 1} else{ return 0 } }

    To me this looks like $val is being treated as a string (if( $val !~ /^\d+$/ )) and then on the next line as a numeric variable ($val >= 0) etc. The code does what I want/expect but how? Is this just 'magic behind the curtain'?

"readdir() attempted on invalid dirhandle" error?
2 direct replies — Read more / Contribute
by Anonymous Monk
on Jul 10, 2024 at 15:12
    I'm tearing my hair out over what should be a Perl 101 issue, and just can't tell what's going on. I have a script that processes some stuff, and then sends a directory over to a separate module for further processing. The module is unable to read the directory, and I don't know why. The code (so far!) is incredibly simple:
    sub process_directory { my ($self, $dir) = @_; print "TESTING: dir is [$dir]\n"; open my $dh, $dir or die "Could not open dir [$dir] for reading: $ +!\n"; my @files = readdir $dh; print "FILES: @files\n"; closedir $dh; }
    When I run this, I get:
    TESTING: dir is [/tmp/testdirectory] readdir() attempted on invalid dirhandle $dh at /path/to/ li +ne 14. FILES: closedir() attempted on invalid dirhandle $dh at /path/to/ l +ine 18.

    /tmp/testdirectory exists, it's a directory, and the caller has permissions to read it.

    I'm using strict and warnings. I don't get this--the open didn't fail; what's the problem here? I've searched for this, and the usual error is that people try reading a file as a directory or something like that; that's not the case here.
JAVA [[a-z]&&[^aeiou]] equivalence
4 direct replies — Read more / Contribute
by vincentaxhe
on Jul 10, 2024 at 00:59
    It's easy to guess what
    try to match, How perl do such thing, it's not included in primary perl pattern match knowledge.
SQLite returns funny characters
2 direct replies — Read more / Contribute
by jmClifford
on Jul 09, 2024 at 09:58

    Hi. I have SQLite with the Perl, where some text values returned are Degrees C and Degrees F and the "Degrees" is a small super scripted °. And when this is returned to my Perl console it can show as °F. How can I easily convert / display this new font which I assume is not the usual ASCII (or my keyboard) font.

    Regards JC.....

Referer header
3 direct replies — Read more / Contribute
by frank1
on Jul 09, 2024 at 09:00

    Am having a problem from my script. this is the error am getting Forbidden (403) CSRF verification failed. Request aborted. You are seeing this message because this HTTPS site requires a “Referer header” to be sent by your Web browser, but none was sent. This header is required for security reasons, to ensure that your browser is not being hijacked by third parties.

    #!/usr/bin/perl use lib '.'; use strict; use warnings; use HTTP::Tiny; use JSON; use LWP::UserAgent; my $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 0 }, ); $ua->agent("MyApp/0.1"); my $referer = $ENV{HTTP_REFERER}; my $callback = ""; my $address = ""; my $pending = "1"; my $confirmations = "1"; my $email = ''; my $json = "1"; my $post = "0"; my $priority = "default"; my $multi_token = "0"; my $convert = "0"; my $req = HTTP::Request->new(POST=>"https://link?callback=$callback&ad +dress=$address&pending=$pending&confirmations=$confirmations&email=$e +mail &post=$post&json=$json&priority=$priority&multi_token=$multi_token&con +vert=$convert"); $req->referer($referer); my $Response_Req = $ua->request($req); if($Response_Req->is_success){ print $Response_Req->content ."\n"; } else{ print "Error: " . $Response_Req->status_line; }
Closed:how to argparse same option to array instead of overwrite
2 direct replies — Read more / Contribute
by vincentaxhe
on Jul 09, 2024 at 00:15
    I wish arg parser can put same option's args into an array like this;
    use Getopt::xxx; getopts('e:'; \%options); if (ref $options{e} eq 'ARRAY'){ print 'you got e args with', $options{e}->@*; }else { print 'your e arg is ', $options{e} }
    I can run like -e 'a' -e 'b' to get 'you got e args with a b'.what module is designed to do such thing.


    I write my own argparser to keep order and add same option args:)

    my $all_options = "xp:b:f:s:"; my @s_options = $all_options =~ /[^:](?=:)/g; my @n_options = $all_options =~ /[^:](?!:)/g; my (@options, %options, $need); sub parsearg($$){ my ($index, $arg) = @_; if ($arg !~ /^-/){ return 1 if $index ne $need; } foreach (@s_options){ if ( $arg eq '-'.$_){ push @options, [$_, $ARGV[$index + 1]]; $need = $index + 1; return 0 } } foreach (@n_options){ if ($arg eq '-'.$_){ $options{$_} = 1; $need = $index; return 0 } } } while (my ($index, $argv) = each @ARGV){ last if parsearg $index, $argv; } my @files = splice @ARGV, $need + 1;
Console cursor position control
2 direct replies — Read more / Contribute
by jmClifford
on Jul 08, 2024 at 10:21

    Hi. I would like to control the position of the cursor on the console display of my Perl_Eclipse_IDE. When I, print "Input command: "; then the cursor needs to be at the end of this outputted string, and not where I stopped typing on a previous input.

    Regards JC.....

Private variable in class method does not go out of scope
3 direct replies — Read more / Contribute
by daniel85
on Jul 08, 2024 at 06:19

    Dear Monks,
    I have encountered a quite crazy issue with Perl. Please look at the following example:

    { package FooObj; sub new { bless { _count => 1, _data => 0 }, $_[0] } sub add_data { my $self = shift; my $data = shift if (@_); print "\nCalled: data value is " . ($data || "NONE") . "\n"; if (defined $data) { die "\nError: data does not look like num +ber\n\n" if ($data !~ /^\d+$/); } if ($self->{_count}) { $data = 5 if (!defined $data); $self->{_data} += $data; $self->{_count}--; return($self->{_data}); } } } my $bar = FooObj->new; while(my $val = $bar->add_data()) { # do something here }

    In the above example, the method add_data() should be called twice. Both times, the method is called with no argument, therefore the private variable $data should be undefined. Later on, inside the method, if $data was not defined, it gets assigned a value of 5.

    Here comes the weird part. If you run the above code, it outputs:

    Called: data value is NONE

    Called: data value is 5

    It looks like, the second time add_data() gets called, $data did not go out of scope and its previous value is still there.
    However, if I replace the line my $data = shift if (@_); with my $data = shift;, I get the expected output:

    Called: data value is NONE

    Called: data value is NONE

    Can someone please explain me what is going on? Is this a Perl bug or am I missing something??



PerlTk using -configure across frames
1 direct reply — Read more / Contribute
by colintu
on Jul 07, 2024 at 09:50

    I'm trying to call configure for a widget that is in a different frame to the one the current callback is running from. It doesn't work, I'm getting Tk::Error output. System is Debian Bullseye. code is:

    #!/usr/bin/perl use strict; use Tk; use Tk::TFrame; my $con_but_txt = "Connect"; my $online = 0; my $rd_b2; # Set the software version and display it! my $statusmsg = 'Version 0.1'; #------------ my $mw = MainWindow->new; #------------ my $seg2_f = $mw->TFrame(-label => 'Segment 2', -relief => 'groove', -borderwidth => 2); $rd_b2 = $seg2_f->Button(-text => "Read", -state => 'disabled', -comma +nd => [\&read_seg, 2]); $rd_b2->grid(-row => 3, -column => 1, -sticky => "e", -padx => 4); my $ts_e2 = $seg2_f->Text(-wrap => 'word', -width => 50, -height => +6)->grid( -padx => 4, -p +ady => 4, -row => 0, -co +lumn => 3, -sticky => "ns +ew", -rowspan => 4); $seg2_f->grid(-row => 1, -column => 0, -sticky => "nsew",-padx => 2); #------------- my $base_f = $mw->Frame( -relief => 'groove', -borderwidth => 2); my $status = $base_f->Label(-textvariable => \$statusmsg, -borderwidth + => 2, -width => 20, -relief => 'groove')->grid(-row => 1, +-column => 0, -sticky => "w",-padx => 2,-pady => 3); my $conn_b = $base_f->Button(-textvariable => \$con_but_txt, -command +=> \&connect)->grid(-row => 1, -column => 3, -sticky +=> "e"); $base_f->Button(-text => "Exit", -command => sub {exit})->grid(-row => + 1, -column => 4, -sticky => "e" +); $base_f->grid(-row => 2, -column => 0, -sticky => "w",-padx => 2); #------------- #----------------------------------------- sub read_seg { my $cnt; my $inpstr; my ($segnum) = @_; $statusmsg = sprintf("Reading Segment %d", $segnum); $mw->update(); $mw->after(500); $statusmsg = "Online"; $mw->update(); } sub connect { my $cnt; my $inpstr; # Connect / Disconnect # if ($online == 0) { $online = 1; $con_but_txt = "Disconect"; $statusmsg = 'Online'; } else { $online = 0; $con_but_txt = "Connect"; $statusmsg = 'Offline'; } update_buttons(); } # Enable/Disable various buttons # sub update_buttons { if ($online == 0) { # We are Offline # $rd_b2->cofigure(-state => 'disabled'); $mw->$seg2_f->$rd_b2->cofigure(-state => 'disabled'); } else { # We are Online # $rd_b2->cofigure(-state => 'normal'); $mw->$seg2_f->$rd_b2->cofigure(-state => 'normal'); } }

    As you can see from update_buttons I've tried just the widget handle and also a chain down from $mw. Both give output like:

    Tk::Error: Can't locate auto/Tk/TFrame=HASH(0x55a20d8dde70).al in @INC + (@INC contains: /etc/perl /usr/local/lib/x86_64-linux-gnu/perl/5.32. +1 /usr/local/share/perl/5.32.1 /usr/lib/x86_64-linux-gnu/perl5/5.32 / +usr/share/perl5 /usr/lib/x86_64-linux-gnu/perl-base /usr/lib/x86_64-l +inux-gnu/perl/5.32 /usr/share/perl/5.32 /usr/local/lib/site_perl) at +./ line 91. Carp::croak at /usr/lib/x86_64-linux-gnu/perl-base/ line 289 AutoLoader::autoload_sub at /usr/lib/x86_64-linux-gnu/perl-base/AutoL line 54 AutoLoader::AUTOLOAD at /usr/lib/x86_64-linux-gnu/perl-base/AutoLoade line 23 main::update_buttons at ./ line 91 main::connect at ./ line 80 Tk callback for .frame.button Tk::__ANON__ at /usr/lib/x86_64-linux-gnu/perl5/5.32/ line 251 Tk::Button::butUp at /usr/lib/x86_64-linux-gnu/perl5/5.32/Tk/Button.p +m line 175 <ButtonRelease-1> (command bound to event)

    I'm obviously doing something stupid, but it's been 10 years since I wrote any serious Perl and I can't see my mistake. Help please

Tk TableMatrix highlighted cell color
1 direct reply — Read more / Contribute
by Takamoto
on Jul 05, 2024 at 10:40

    Given this code

    use Tk; use Tk::TableMatrix::Spreadsheet; my $t = $top->Scrolled('Spreadsheet', -rows => 21, -cols => 11, -width => 6, -height => 6, -titlerows => 1, -titlecols => 1, -variable => $arrayVar, -selectmode => 'extended', -bg => 'white', );

    Is it possible to modify the default color of the highlighted (active) cells in a Tk-TableMatrix table without rewriting the whole logic with tags?

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
    Domain Nodelet?
    and the web crawler heard nothing...

    How do I use this?Last hourOther CB clients
    Other Users?
    Others pondering the Monastery: (3)
    As of 2024-07-13 07:30 GMT
    Find Nodes?
      Voting Booth?

      No recent polls found

      erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.