Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

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. Post a new question!

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.

User Questions
Handling Exceptions on Net::SSH::Expect
1 direct reply — Read more / Contribute
by pablor
on Jan 16, 2017 at 14:56

    I am using Net::SSH::Expect to connect to a list of access points.

    In some cases the connection dies and my script gets interrupted. I want the script to skip the AP but continue with the following ones, but the script dies

    my $sshap = Net::SSH::Expect->new ( host => $apip, user => 'Cisco', ssh_option => '-o StrictHostKeyChecking=no', raw_pty => 1, timeout => 5 ); if($sshap->run_ssh()){ $sshap->waitfor ('Password:', 7) or warn "SSH problem: 'Password' +not found after 7 second"; $sshap->send ('Cisco'); $sshap->waitfor ("$ap\>", 3) or warn "SSH problem: $ap\> not found + after 3 second"; $sshap->send ('en'); $sshap->waitfor ('Password:', 3) or warn "SSH problem: 'EN Passwor +d' not found after 3 second"; $sshap->send ('Cisco'); $sshap->waitfor ("$ap\#", 3) or warn "SSH problem: $ap\# not found + after 3 second"; $sshap->send ('show ip interface brief'); while (defined ($line = $sshap->read_line()) ) { print "$line\n" } $sshap->send('exit'); $sshap->close(); } else { print "$apname Could not open SSH\n"; }

    I found that I can handle that by using eval{}

    Is that the best approach?

    it seems that is running much slower when I use eval.

Some help with my proyect:
1 direct reply — Read more / Contribute
by 0uts1de
on Jan 16, 2017 at 14:01

    Hi monks,i am quite new in perl programming (only 2 weeks learning)and i have a question about my script, the idea is that the script prints some things about a choosen filesystem and gives the avalible space, the used space, the type, etc.

    All sounds good, but when I run my script it returns a error ("Illegal division by zero at analizer (16-1-17).pl line 35, <STDIN> line 1.") and I dont know how to fix it or what is working bad, the code is this: (NOTE: I am spanish so i write the comments in my lenguaje, sorry if u dont understand it but i dont think is necesary a traduction)

    #!usr/bin/perl #solo funciona para unix/linux/solaris(solaris ni idea) #si da el error "Undefined subroutine &main::SYS_statfs called at +Filesys/DiskSpace.pm at line XXX", editar syscall.ph # (en el perl lib tree) y copiar la linea "SYS_statfs {196;}" fuer +a del "if (defined &__hp9000s800)" (alrededor de la linea 356) use strict ; use warnings ; use Filesys::DiskSpace ; use POSIX ; #sistema de archivos/particion a comprobar espacio #sacar fecha ; my $TIME = strftime("%d/%m/%Y %H:%M:%S", localtime(time) ) ; print "+----------+---+----------+\n" ; print "+Script made up by 0uts1de+\n" ; print "+----------+---+----------+\n" ; print "Today is $TIME \n" ; print "Write the filesystem/partiton you want to monitor, for exam +ple /home or /usr \n" ; my $monit = <STDIN> ; chomp $monit ; print "##warning level is by default about a 20 % of free space, i +f u want to change this##\n" ; print "##change the variable warn in the script with a editor like + vim or gedit ##\n" ; ########## warn string ############ my $warn = 10 ; ################################### #consegir caracteristicas de la particion/filesystem (raw) my ($fs_type, $fs_desc, $used, $avail, $fused, $favail) = df $moni +t ; my $monit_percentual = ( $avail / $avail+$used ) * 100 ; my $final_used = $used / 1000 ; my $final_avail = $avail / 1000 ; print "$monit is a $fs_type filesystem who has $final_used space u +sed (in MB) and $final_avail of avalible space (in MB too) \n" ; #comparacion con el porcentaje de $monit_percentual if ($monit_percentual < $warn) { print "Less of the $warn % of the space of the filesystem +$monit is avalible for use, consider uninstall unused software \n" ; } elsif ($monit_percentual eq $warn) { print "Be carefull, exactly the $warn % of the space of $m +onit is usable, consider uninstall unused software \n" ; } else { print "There is a $monit_percentual % of avarible space of + the disk \n" ; }

    In the imput I have the error and the rest, here is:

    +----------+---+----------+ +Script made up by 0uts1de+ +----------+---+----------+ Today is 16/01/2017 16:31:04 Write the filesystem/partiton you want to monitor, for example /home o +r /usr / ##warning level is by default about a 20 % of free space, if u want to + change this## ##change the variable warn in the script with a editor like vim or ged +it ## Illegal division by zero at analizador de filesystem (16-1-17).pl line + 35, <STDIN> line 1.

    Thanks in advance!

New error message in ActivePerl 5.22
3 direct replies — Read more / Contribute
by dhannotte
on Jan 16, 2017 at 09:14
    I recently decided it was time to upgrade my Windows 64-bit version of ActivePerl from 5.10.1.1007 to 5.22.2.2203. I'm now getting a new error message when I try to "use" the collection of generally useful subroutines I keep in Plx.pm:
    E:\!!!dh()testplx Can't use 'defined(@array)' (Maybe you should just omit the defined()? +) at (#2) line 2842. Compilation failed in require at C:\!dh\DH\COM\SRC\testplx.pl line 4. BEGIN failed--compilation aborted at C:\!dh\DH\COM\SRC\testplx.pl line + 4.
    This is testplx.pl in its entirety:
    use Carp; $SIG{__WARN__} = \&carp; $SIG{__DIE__} = \&confess; use Plx;

    Line 2842 of Plx.pm is: my ($err_num, $err_txt);

    There are 101 occurences of the string "defined" in 98 lines of Plx.pm.

    1) Why isn't Carp identifying the correct line?

    2) Besides going through 101 occurences, how can I find where (and WHAT) this error really is?

    Thanks, everybody!
DBIx or Catalyst problem: Lost connection to MySQL server during query
1 direct reply — Read more / Contribute
by Largo
on Jan 16, 2017 at 09:04

    Hi there!

    I'm working on a project using the Catalyst framework. The db access is done by DBIx::Class. All works fine until the queries get too complicated and take too long to run.

    Therefore I wrote a test script to find out if there is a fix amount of time after which the db crashes and the answer is yes. If a query takes longer than 50 seconds then we get the error msg:

    DBI Exception: DBD::mysql::st execute failed: Lost connection to MySQL server during query

    For testing I use the query "SELECT SLEEP(n);" which does nothing but to sleep for n seconds and then returns.
    Here is my test code:

    use encs; my $sto = encs->model("DB::Exset")->new({})->result_source->schema +->storage; printf("start\n"); foreach my $i (49,50,51,52,53,49) { print("wait $i seconds:\n"); my $t1 = time; my $t2 = undef; eval { $sto->dbh_do( sub { my ($storage, $dbh, @cols) = @_; $t2 = time; my $sth = $dbh->prepare("Select sleep($i)") or die $db +h->errstr; $sth->execute or die $sth->errstr; my $data = $sth->fetchrow_hashref; } ); }; if ( $@ ) { printf("ERROR: %s (%d, %d)\n", $@, time - $t1, time - $t2); + } else { printf("Ok: (%d, %d)\n", time - $t1, time - $t2); } } printf("end\n"); exit;
    A typical run:
    start wait 49 seconds: Ok: (92, 49) wait 50 seconds: Ok: (86, 50) wait 51 seconds: ERROR: {UNKNOWN}: DBI Exception: DBD::mysql::st execute failed: Lost c +onnection to MySQL server during query [for Statement "Select sleep(5 +1)"] at ./script/encs_wetest.pl line 32 (86, 51) wait 52 seconds: ERROR: {UNKNOWN}: DBI Exception: DBD::mysql::st execute failed: Lost c +onnection to MySQL server during query [for Statement "Select sleep(5 +2)"] at ./script/encs_wetest.pl line 32 (51, 51) wait 53 seconds: ERROR: {UNKNOWN}: DBI Exception: DBD::mysql::st execute failed: Lost c +onnection to MySQL server during query [for Statement "Select sleep(5 +3)"] at ./script/encs_wetest.pl line 32 (51, 51) wait 49 seconds: Ok: (49, 49) end

    "encs" is my Catalyst class. 50 seconds are running through and 51 seconds are failing. Interestingly the query breaks everey time after 51 seconds, but it's not the mysql server that ends the connection. There ist no error message at the mysql server. If I setup a DBI connection on my own, without Catalyst, then it runs as long as it takes. Therefore I think it's an Catalyst/DBIx issue.

    My Catalyst YAML config for db: Model::DB: schema_class: encs::Schema::DB connect_info: dsn: dbi:mysql:encs01_test:encsdb user: uu password: xxxxx options: mysql_connect_timeout: 600 net_read_timeout: 600 net_write_timeout: 600

    Does anybody have an idea what is the problem? How I could configure Catalyst to avoid this timeout?

    Thx, Lars

using syscalls in perl through inline c
2 direct replies — Read more / Contribute
by ofer
on Jan 16, 2017 at 09:03
    Hi, My problem is I want to use the getdents() syscall from perl to receive a file list since the h2ph interface feels a bit awkward to me I'm trying to use Inline C function and receive the contents of the directory back into a variable since speed is an issue. this is my first time using Inline C in perl and there isn't a lot of documentation about it's usage and it seems that Inline has some internals variables to push the data back into perl ideally as a scalar.
    #!/usr/bin/env perl use 5.012; use strict; use warnings; my $str = &listfiles('<Directory>'); print $str; use Inline C => <<'END_OF_C_CODE'; #include <dirent.h> /* Defines DT_* constants */ #include <fcntl.h> #include <stdio.h> #include <unistd.h> #include <stdlib.h> #include <sys/stat.h> #include <sys/syscall.h> #define handle_error(msg) do { perror(msg); exit(EXIT_FAILURE); } whil +e (0) struct linux_dirent { long d_ino; off_t d_off; unsigned short d_reclen; char d_name[]; }; #define BUF_SIZE 1024*1024*5 int listfiles(int argc, char *argv[]) { int fd, nread; char buf[BUF_SIZE]; struct linux_dirent *d; int bpos; char d_type; fd = open(argc > 1 ? argv[1] : ".", O_RDONLY | O_DIRECTORY); if (fd == -1) handle_error("open"); for ( ; ; ) { nread = syscall(SYS_getdents, fd, buf, BUF_SIZE); if (nread == -1) handle_error("getdents"); if (nread == 0) break; for (bpos = 0; bpos < nread;) { d = (struct linux_dirent *) (buf + bpos); if (d->d_ino != 0) printf("%s\n", (char *) d->d_name); bpos += d->d_reclen; } } exit(EXIT_SUCCESS); } END_OF_C_CODE
How to change file creation date?
1 direct reply — Read more / Contribute
by PetreAdi
on Jan 16, 2017 at 02:03
    How to change file creation date (ctime)? W7 64 bits
Parse a file and store it in hash of hashes
4 direct replies — Read more / Contribute
by Sonali
on Jan 15, 2017 at 23:59

    I want to parse the following file which is in the below format and generate a hash of hash to store it. Obviously a newbie.

    [CELL_NAME1] COMMENT = "Perl parsing" FIRST = "TEST1" SECOND = "ID1" THIRD = 123 FOURTH = "THREE" FIFTH = 12345 SIXTH = 6789 SEVENTH = QWERTY [CELL_NAME2] COMMENT = "Tester" FIRST = "TEST2" SECOND = "ID2" THIRD = 1234 FOURTH = "FOUR" FIFTH = 12345 SIXTH = BOARD SEVENTH = MOUSE [CELL_NAME3] COMMENT = "Parser" FIRST = "TEST3" SECOND = "ID3" THIRD = 12345 FOURTH = "FIVE" FIFTH = 12345 SIXTH = PAD SEVENTH = KEY

    My code goes like this

    #!/usr/local/bin/perl use strict; use warnings; use Data::Dumper; my $filename = 'tester.txt'; my %HoH; my $key; my $value; open(my $fh, '<:encoding(UTF-8)', $filename) or die "Could not open file '$filename' $!"; while ( <$fh> ) { next unless s/^\[(.*?)\]\s*//; my $rec = $1; for my $field ( split /\n/) { ($key, $value) = split /\s*=\s*/, $field; $HoH{$rec}{$key} = $value; } } print Dumper \%HoH;
DBD problem
1 direct reply — Read more / Contribute
by Umdurman
on Jan 15, 2017 at 21:02
    HJey guys, I am trying to read a db and while reading update specific records. Problem is that the while loop works just fine except when I write into the db the while loop stops withy a fetch array error. Here is my code:
    # -------------------------------------------------------------------- +------------------------------------------- # -------------------------------------------------------------------- +------------------------------------------- # -------------------------------------------------------------------- +------------------------------------------- # Update the selected Database record sub UpdateDb { $Dbh = DBI->connect($DbConnectionInfo,$DbUserid,$DbPasswd); $Sth = $Dbh->prepare($UpdQuery); $Sth->execute() or $ErrNum = "3007"; $ErrMess = "$DBI::errstr"; $Sth->finish(); $Dbh->disconnect; print "HIER $ErrMess<br>" } # -------------------------------------------------------------------- +------------------------------------------- # -------------------------------------------------------------------- +------------------------------------------- # -------------------------------------------------------------------- +------------------------------------------- # Query the database, and replace the labels with global values if ($ErrNum eq "0") { $RangeQuery = "WHERE $Field LIKE '%$String%' ORDER BY LstNum ASC"; $Dbh = DBI->connect($DbConnectionInfo,$DbUserid,$DbPasswd); $Sth = $Dbh->prepare("SELECT LstNum, LstName31, LstName01, LstSize +, LstDesc31, LstDesc01, LstPurch, LstSaleP, LstSaleW, LstAmount, LstI +nfo FROM $DbTable $RangeQuery"); $Sth->execute or print "$DBI::errstr"; while (($LstNum, $LstName31, $LstName01, $LstSize, $LstDesc31, $Ls +tDesc01, $LstPurch, $LstSaleP, $LstSaleW, $LstAmount, $LstInfo) = $St +h->fetchrow_array){ if ($Field eq "LstName31") { if ($Replace ne "") { print "String: $String<br>"; print "Replace: $Replace<br><br>"; $LstName31Old = $LstName31; $LstName31 =~ s/$String/$Replace/i; print "Updated $LstNum:<br>Old Value: $LstName31Old<br +>New Value: $LstName31<br>"; } if ($NewValue ne "") { print "String: $String<br>"; print "NewValue: $NewValue<br><br>"; $LstName31Old = $LstName31; $LstName31 = $NewValue; print "Updated $LstNum:<br>Old Value: $LstName31Old<br +>New Value: $LstName31<br>"; } if (($Replace eq "") and ($NewValue eq "")) { print "Current $LstNum:<br>Current Value: LstName31 $L +stName31<br>"; } $UpdQuery = "UPDATE $DbTable SET LstName31 + = '$LstName31' WHERE LstNum = '$LstNum'"; UpdateDb(); } } $Sth->finish(); $Dbh->disconnect; } if (($Replace eq "") and ($NewValue eq "")) { print "<br><br>$Mess<br>"; print "No new values received. No records are updated"; } # -------------------------------------------------------------------- +------------------------------------------- # -------------------------------------------------------------------- +------------------------------------------- # -------------------------------------------------------------------- +-------------------------------------------
windows shortcut and args
1 direct reply — Read more / Contribute
by enrgyxprt
on Jan 15, 2017 at 14:47
    I want windows to open all files with the extension of .bll (Which are text based files) with my perl script. Does windows pass the pathtofile.filename.bll to my script in @ARG ? If not then how can I access this in my script ?
Undiagnosable Problem
4 direct replies — Read more / Contribute
by dhannotte
on Jan 14, 2017 at 10:37

    Last week my Perl interpreter suddenly started issuing a bizarre cascade of warnings every time I tried to run my 'sitegen.pl' script. These warnings claimed that every variable exported from my 'Plx.pm' library had already been defined. It then aborted the interpretation of 'sitegen.pl' entirely at the first invocation of one of these "multiply defined" functions.

    My 'sitegen.pl' script begins with the following 4 "use" statements:

    use Plx; # Programming Language Extensions use PlxHml; # HTML Macro Languages use PlxLang; # Language Services use strict 'vars';

    'Plx.pm' exports 23 functions and begins:

    package PLX; use attributes; use diagnostics; use strict 'vars'; use warnings; use Date::Calc; use Math::BigFloat; use Carp; $SIG{__WARN__} = \&carp; $SIG{__DIE__} = \&confess;

    'PlxHml.pm' exports 1 function and begins:

    package PLXHML; use PLX; use Carp; $SIG{__WARN__} = \&carp; $SIG{__DIE__} = \&confess;

    'PlxLang.pm' exports 3 functions and begins:

    package PLXLANG; use PLX; use Carp; $SIG{__WARN__} = \&carp; $SIG{__DIE__} = \&confess;

    Each of the exported functions is unique. This structure has worked for years without error.

    My Perl site lib contains the following files:

    -------------------------------------------------------------------- c:\Perl64\site\lib()dir Volume in drive C is C-DRIVE Volume Serial Number is E812-30A4 Directory of c:\Perl64\site\lib 01/13/2017 07:34 AM <DIR> . 01/13/2017 07:34 AM <DIR> .. 09/02/2010 02:49 PM <DIR> auto 09/02/2010 02:49 PM <DIR> Image 01/13/2017 07:34 AM 161,042 Plx.pm 01/09/2017 04:33 PM 10,113 PlxHml.pm 01/11/2017 10:28 AM 15,241 PlxLang.pm 01/11/2017 10:27 AM 61,873 PlxSync.pm 01/27/2010 01:36 PM 31 sitecustomize.pl 12/26/2010 01:13 AM 106 test.pm 6 File(s) 248,406 bytes 4 Dir(s) 651,360,083,968 bytes free --------------------------------------------------------------------

    The command I use to interpret sitegen.pl, and the first few and last few of the spurious errors, are:

    -------------------------------------------------------------------- c:\!dh\dh\web\PRC\1()sitegen.pl Subroutine TRUE redefined at C:/Perl64/site/lib/PLX.pm line 280 (#1) (W redefine) You redefined a subroutine. To suppress this warning +, say { no warnings 'redefine'; eval "sub name { ... }"; } Subroutine TRUE redefined at C:/Perl64/site/lib/PLX.pm line 280. at C:/Perl64/site/lib/PlxHml.pm line 13 (#1) Subroutine TRUE redefined at C:/Perl64/site/lib/PLX.pm line 280. at C:/Perl64/site/lib/PlxHml.pm line 13 at C:/Perl64/site/lib/PlxHml.pm line 13 Subroutine FALSE redefined at C:/Perl64/site/lib/PLX.pm line 281 (#1) Subroutine FALSE redefined at C:/Perl64/site/lib/PLX.pm line 281. . . . Subroutine x_yyyy_mm_dd_hh_mm_ss redefined at (#2) line 3990 (#1) Subroutine x_yyyy_mm_dd_hh_mm_ss redefined at (#2) line 3990. at C:/Perl64/site/lib/PlxHml.pm line 13 Undefined subroutine &main::x_hh_mm_ss called at C:\!dh\dh\web\PRC\1\s +itegen.pl line 347. at C:\!dh\dh\web\PRC\1\sitegen.pl line 347 --------------------------------------------------------------------

    Line 280 of Plx.pm is:

      sub TRUE      {1}

    Line 13 of PlxHml.pm is:

      use PLX;

    I suspect that there's a simple explanation for all this, but even after a decade of using Perl, I am unable to imagine what it is. Do these spurious errors ring a bell with anyone? The version of Perl I use is described by the following output from the 'perl -v' and 'perl -V' commands:

    I suppose I could reinstall ActivePerl, but they're no longer friendly to freeloaders like me and this might not succeed. I could try Strawberry Perl, but I don't have LINUX and managing it might be difficult. Before I descend into these circles of hell, I really hope that one of the wise elders here can offer me even a glimmer -- even just a smudgeon -- of insight. Thanks in advance.


Add your question
Title:
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?
    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 pondering the Monastery: (3)
    As of 2017-01-17 03:20 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Do you watch meteor showers?




      Results (151 votes). Check out past polls.