Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
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
DBIx or Catalyst problem: Lost connection to MySQL server during query
No replies — Read more | Post response
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

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
3 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.

[Answered; thanks.] Can this be explained in layman's terms?
3 direct replies — Read more / Contribute
by BrowserUk
on Jan 13, 2017 at 23:16

    Update: Thanks to jaredor, Huck & Athanasius.

    The number of partitions of size k of a set of n elements are known as Stirling numbers of the second kind, and satisfy the recursion:
    • S(0, 0) = 1
    • S(n, 0) = 0 if n > 0
    • S(n, 1) = S(n, n) = 1
    • S(n, k) = S(n-1, k-1) + kS(n-1, k)

    The source is a cpan perl module; a google search will almost certainly discover which one; but that is irrelevant.

    All I'm looking for is a tangible explanation of the above description.

    Can any Monk put me in my place by transcribing the above description into English?


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority". The enemy of (IT) success is complexity.
    In the absence of evidence, opinion is indistinguishable from prejudice.
SOAP Header Data for Perl
1 direct reply — Read more / Contribute
by sujeeva
on Jan 13, 2017 at 17:40

    Hi,

    Could someone please provide me an example of adding SOAP headers to a SOAP call created from wsdl2perl? I just need an example of just a simple header.

    Following is my code:

    my $response = $interface->myOperation( { Value1 => 1, Value2 => 'FOO', },, );

    Thanks,

    Sujeeva

read the value of variable from environment file and set it to another properties file using perl script
2 direct replies — Read more / Contribute
by vishallearningperl
on Jan 13, 2017 at 10:57

    I want to read the value of variable from environment file and set it to another properties file using perl script.

    Environment File

    DOMAIN=<value> DOMAIN_TEST_DB_CONN_STR=<value> DOMAIN_TEST_DB_USER=<value> DOMAIN_TEST_DB_PSWD=<value>

    Properties File

    #These are the properties for engineering #We expect you to change them for your environment # #CustomerDatabase info DOMAIN=<value> DOMAIN_TEST_DB_CONN_STR=<value> DOMAIN_TEST_DB_USER=<value> DOMAIN_TEST_DB_PSWD=<value>

    I tried following but not working. Kindly please suggest.

    $envfile="/root/env.properties"; @envFile=<$env>; open my $env, '<', $envfile or die "Can't read old file: $!"; open my $in, '<', $file or die "Can't read old file: $!"; open my $out, '>', "$file.new" or die "Can't write new file: $!"; print "\nFile contents:"; print @envFile; foreach $envline (@envFile){ while ( <$in> ){ print "$. $_"; if($envline =~/$DOMAIN_DB_CONN_STR=.*:1521:.*/ && $_=~/$DOMAIN +_DB_CONN_STR=.*:1521:.*/){ print "\nMatch"; $line=$_; $line =~ s/$DOMAIN_DB_CONN_STR=.*:1521:.*/NUANCE_DB_CO +NN_STR=$dbhost:$dbport:$dbschema/; print $out $line; } } }
debug output from TODO with Test::More
3 direct replies — Read more / Contribute
by 1nickt
on Jan 13, 2017 at 09:40

    Hi all,

    I'm looking for techniques to provide debug output from a TODO test running with Test::More.

    What I want to do is output an additional message when a TODO test starts passing, to remind me to take some action. I can get the message to print with diag() when running in verbose mode, but not otherwise.

    use Test::More tests => 2; TODO: { local $TODO = ' '; is(1,1,'Inside') and diag 'In'; } is(1,1,'Outside') and diag 'Out';
    Output under verbose:
    $ prove -lrv foo.t foo.t .. 1..2 ok 1 - Inside # TODO # In ok 2 - Outside # Out ok All tests successful. Test Summary Report ------------------- foo.t (Wstat: 0 Tests: 2 Failed: 0) TODO passed: 1 Files=1, Tests=2, 0 wallclock secs ( 0.02 usr 0.00 sys + 0.01 cusr + 0.00 csys = 0.03 CPU) Result: PASS
    Output without verbose:
    $ prove -lr foo.t foo.t .. 1/2 # Out foo.t .. ok All tests successful. Test Summary Report ------------------- foo.t (Wstat: 0 Tests: 2 Failed: 0) TODO passed: 1 Files=1, Tests=2, 0 wallclock secs ( 0.02 usr 0.00 sys + 0.02 cusr + 0.00 csys = 0.04 CPU) Result: PASS
    I know that Test::More clones STDOUT and STDERR and other black magic ... but is there any way to accomplish what I want?

    Thanks in advance!

    Note:

    • The problem is compounded when the order of tests is reversed, as the diag() messages and test results seem to print out of order, under verbose:
      use Test::More tests => 3; is(1,1,'Outside') and diag 'Out'; TODO: { local $TODO = ' '; is(1,1,'Inside') and diag 'In'; } is(1,1,'Back Outside') and diag 'Out Again';
      Output without verbose:
      $ prove -lr foo.t foo.t .. 1/3 # Out # Out Again foo.t .. ok All tests successful.
      Output with verbose:
      $ prove -lrv foo.t foo.t .. 1..3 ok 1 - Outside ok 2 - Inside # TODO # In ok 3 - Back Outside # Out # Out Again ok All tests successful.


    The way forward always starts with a minimal test.

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?
    Corion is in a similar situation.#

    How do I use this? | Other CB clients
    Other Users?
    Others studying the Monastery: (12)
    As of 2017-01-16 14:10 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Do you watch meteor showers?




      Results (150 votes). Check out past polls.