Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical

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.

New 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/ 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/ 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/ 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

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 '' script. These warnings claimed that every variable exported from my '' library had already been defined. It then aborted the interpretation of '' entirely at the first invocation of one of these "multiply defined" functions.

    My '' 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';

    '' 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;

    '' exports 1 function and begins:

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

    '' 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 01/09/2017 04:33 PM 10,113 01/11/2017 10:28 AM 15,241 01/11/2017 10:27 AM 61,873 01/27/2010 01:36 PM 31 12/26/2010 01:13 AM 106 6 File(s) 248,406 bytes 4 Dir(s) 651,360,083,968 bytes free --------------------------------------------------------------------

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

    -------------------------------------------------------------------- c:\!dh\dh\web\PRC\1() Subroutine TRUE redefined at C:/Perl64/site/lib/ 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/ line 280. at C:/Perl64/site/lib/ line 13 (#1) Subroutine TRUE redefined at C:/Perl64/site/lib/ line 280. at C:/Perl64/site/lib/ line 13 at C:/Perl64/site/lib/ line 13 Subroutine FALSE redefined at C:/Perl64/site/lib/ line 281 (#1) Subroutine FALSE redefined at C:/Perl64/site/lib/ 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/ line 13 Undefined subroutine &main::x_hh_mm_ss called at C:\!dh\dh\web\PRC\1\s line 347. at C:\!dh\dh\web\PRC\1\ line 347 --------------------------------------------------------------------

    Line 280 of is:

      sub TRUE      {1}

    Line 13 of 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.

Cannot get Perl to match a specific string in my textfile
3 direct replies — Read more / Contribute
by skasch
on Jan 12, 2017 at 09:50
    Dear list,

    I am a beginner with Perl and seek wisdom of the monks

    What i want is to read a file, run a regex on its lines and when matching substitute some strings according to a map.

    Mostly that does work but on a specific line, i cannot get my regex to match and I like to understand why

    This is an excerpt of one of the files that should be processed

    "" = <*I0>; }; SubscribedFolders = ( "" ); FoldersOrder = ( personal, "user_A_domain_D_com_BCA-513DD600-1B-6967B200", "7D03-5682B480-975-5FFE8000", "7D03-5682B480-977-5FFE8000" ); FreeBusyExclusions = { "" = <*I0>; "" = <*I1>;

    And this is my Code

    #!/usr/bin/perl use strict; use warnings; use autodie; my %replacements = ( '' => 'uname', '' => 'user', ); open( my $readFile, '<', "sampleFile" ); while ( <$readFile> ) { # if contains :Calendar and is suffixed with / # or :Contacts with same suffix or Users prefixed # with / or is an email-address followed by " = if ( m/:Calendar(?=\/)/, m/:Contacts(?=\/)/, m/(?<=\"\/)Users/, m/.+@.+\"\s=/) { # then replace every occurrence as in list foreach my $key ( sort keys %replacements ) { s/\b$key\b/$replacements{$key}/g; } } print $_; }

    And this is the result

    "uname:Calendar/personal" = <*I0>; }; SubscribedFolders = ( "" ); FoldersOrder = ( personal, "user_A_domain_D_com_BCA-513DD600-1B-6967B200", "7D03-5682B480-975-5FFE8000", "7D03-5682B480-977-5FFE8000" ); FreeBusyExclusions = { "uname:Calendar/personal" = <*I0>; "user:Calendar/BCA-513DD600-1B-6967B200" = <*I1>;

    I do not understand why my regex does not match the string under "Subscribed Folders" any help is greatly appreciated

    cheers, Sascha
EOF problem with Dancer streaming proxy
2 direct replies — Read more / Contribute
by dsheroh
on Jan 12, 2017 at 08:59
    I have a system which needs to act as a proxy to another of our servers, mainly for legacy support reasons. With the help of Dancer as a proxy, I've managed to get it mostly working with the following code:
    return send_file( \'ignored', streaming => 1, callbacks => { override => sub { eval { my $client_connection = shift; my $ua = LWP::UserAgent->new; my $client; my $status = $ua->get($real_url, ':content_cb' => sub { my ($data, $resp) = @_; unless ($client) { my $headers_in = $resp->headers; my %headers_out = ( 'Content-Disposition' => sprintf('inline; filename="%s"', $file->{fileName}), ); for (qw( Content-Type Content-Length Keep-Alive Last-Mod +ified )) { $headers_out{$_} = $headers_in->header($_) if $headers_in->header($_); } $client = $client_connection->([$resp->code, [%headers_o +ut]]); } $client->write($data); }); if ($status->is_error) { my $headers_in = $status->headers; my %headers_out; for (qw( Content-Type Content-Length Keep-Alive Last-Modif +ied )) { $headers_out{$_} = $headers_in->header($_) if $headers_in->header($_); } my $client = $client_connection->([$status->code, [%header +s_out]]); $client->write($status->error_as_HTML); } 1; } or warn "Proxy failure: $@"; return; }, }, );
    I say "mostly working" because, while the files are streamed successfully and browsers will accept them without complaint, wget and curl are less forgiving. Both of these command-line programs issue errors after the file is (successfully) received:
    $ curl -sS -o rcvd https://foo/bar.pdf curl: (18) transfer closed with outstanding read data remaining $ wget https://foo/bar.pdf <...> 2017-01-12 14:48:58 (6.10 MB/s) - Read error at byte 3316868 (Success. +).Retrying. <proceeds to loop endlessly>
    The byte at which wget reports the read error is always the last byte of the file (i.e., equal to the file size), leading me to suspect that an EOF marker isn't being handled properly. Possibly also relevant is that, while the proxying code copies the Content-Length header from the original source, the original source does not provide that header, so Content-Length is not actually set.

    Using curl/wget to download the file directly from the original source works perfectly with no error messages issued.

    Does anyone have any insights as to what the cause of the problem might be?

Non-Linear Minimization
2 direct replies — Read more / Contribute
by baxy77bax
on Jan 11, 2017 at 10:17

    I have a question. I R there is function called nlm (Non-Linear Minimization function) and it takes a function and a start parameter. Example:

    A <- function(f){ lh(a=f,...(ther parameters)) } B <- function(t){ -log(t(f=t)) } start = (some value) nlm(B,p=c(start))
    Is there something simmilar in perl and could someone be so kind to give an example?
Multiple actions triggered by failure to open a file
1 direct reply — Read more / Contribute
by GreenLantern
on Jan 10, 2017 at 10:54

    Hello Monks,

    I'm having an issue i wasn't planning on running into this morning.... thought i've done it before in the past... but i guess i'm reducing to asking for master-help.

    I want to have multiple actions occur if an open statement doesn't work. Check out my code below and you'll see what i'm talking about.


    #!/tps/bin/perl -s open (my $log_FH, '>', './testlogfile.txt') || { print "failure to open log file..........."; die 'Failure to open log file.....'; } close($log_FH);

    The issue i get from the above is:

    syntax error at ./ line 6, near "die"

    Execution of ./ aborted due to compilation errors.

    i'm running perl, v5.8.3 built for sun4-solaris Thanks folks
Begginer's question: If loops one after the other. Is that code correct?
3 direct replies — Read more / Contribute
by predrag
on Jan 10, 2017 at 08:00

    Hi All, brand new to perlmonks here, from few days ago and it is my first post. I came to Perl last spring (from Linux and bash scripting), really love it, learned a bit and finished some small projects, but still a begginner. My question is: Is it correct to use few if loops one after the other, as I did in this code? So, loops are not nestled and the midle if loop is with else. All that is a content of a foreach loop.

    if ($char eq "a") { some code } if ($k ==2) { some code } else { some code } if ($char eq "b") { some code }

    I know standard use of loops, but somehow, while trying to make my script work, I've came to this solution, that works well in my case. There is only few similar examples of using if loops such way I've found on the web, so I don't know if it is ok and maybe it is considered something to avoid or a dirty code? If it is ok, I would like to hear your comments about the whole script, but maybe that should be sent with other title. If not ok, I will begin to write the other code.

DateCalc using Date::Manip
5 direct replies — Read more / Contribute
by tsdesai
on Jan 10, 2017 at 04:38
    Hi all, I have an old perl code running from perl 5 version 12 using DateManip and DateCalc on Solaris which runs as it should. We have recently migrated to linux perl 5 version 16 and the DateCalc function doesn't work at all. I am trying to count days between two dates for example, i have tried to output what are the inputs to the DateCalc function
    use Date::Manip; my $dt1='2016080100:00:00'; my $dt2='2016123100:00:00'; my $dtopt= DateCalc($dt1,$dt2); print $dtopt;
    The above code outputs 0:0:0:0:6576:0:0 where as the old version on Solaris outputs as +0:0:+21:5:1:0:0 I am expecting the output to be as old version of perl. I know there is some problem with the format but unable to figure it out. I would really appreciate any help. I have tried to use ParseDate,Delta_Format but the result is same. P.S this is not my code i am trying to fix this. Many Thanks, Teju
Inline::C Undefined subroutine with uint8_t C function parameter
1 direct reply — Read more / Contribute
by stevieb
on Jan 09, 2017 at 15:51

    This is more of a curiosity thing than anything as I must admit, I don't know a whole lot of C.

    Can someone explain what I'm missing in the below code? In the C num() function, I have a uint8_t argument, which causes an error:

    Undefined subroutine &main::num called at line 6.

    The broken code:

    use warnings; use strict; use Inline 'C'; num(1); __END__ __C__ #include <stdio.h> #include <inttypes.h> void num(uint8_t number){ printf("%d\n", number); }

    However, if I accept the argument as an int, and then cast it to uint8_t, it works fine:

    void num(int number){ number = (uint8_t)number; printf("%d\n", number); }

    The code that breaks in Perl (uint8_t in the function definition) works fine when compiling/running it as a straight up C program.

New Cool Uses for Perl
Reading from an HC-SR04 ultrasonic distance sensor on the Raspberry Pi
1 direct reply — Read more / Contribute
by stevieb
on Jan 13, 2017 at 17:38

    I've completed another Raspberry Pi related distribution, RPi::HCSR04. This one allows you to use Perl to read data from the HC-SR04 ultrasonic distance sensor.

    It's trivial to use, however, because it uses wiringPi internally, your scripts require root privileges.

    use warnings; use strict; use feature 'say'; use RPi::HCSR04; my $trig_pin = 23; my $echo_pin = 24; my $sensor = RPi::HCSR04->new($trig_pin, $echo_pin); # each call is a separate poll say $sensor->raw; say $sensor->cm . " cm"; say $sensor->inch . " \"";


    634 10.915135593358 cm 4.29729747772217 "

    There's still a bit more work I have to do (catch out-of-range measurements etc), but it works pretty well and is surprisingly accurate.

    Note that per the documentation, the HC-SR04 requires 5v in, and also returns 5v from the ECHO pin back to the Pi's GPIO (which only handles 3.3v), so a voltage regulator or voltage divider is required to limit the voltage to a healthy 3.29v. I opted for the divider while writing the software. Here's a diagram depicting how I achieved that.

    Next up, a SN74HC595 shift register, as I need it to continue to work on the other various projects I have going on. I've almost completed the dist for the BMP180 barometric/altimeter sensor, as well as the MCP300x series analog-to-digital converters.

Perl interface to analog inputs on the Raspberry Pi
2 direct replies — Read more / Contribute
by stevieb
on Jan 11, 2017 at 11:16

    Over the last few months, I've been writing Perl modules/distributions to interact with a Raspberry Pi, its GPIO, and external hardware/devices. My primary objective is to create a complete indoor grow room automation system.

    The past week and a half, I have been focusing on writing a distribution that provides Perl users a way to interact with Adafruit's ADS1xxx Analog to Digital Converters (ADC), so that I could communicate with analog devices via the Pi which does not have any analog inputs. Hence, RPi::ADC::ADS was born.

    The vast majority of functionality specified in the unit's datasheet has been incorporated into this XS-based module, and the documentation outlays all of the critical pieces from the hardware docs.


    • operates on the i2c bus, can connect four units simultaneously for a total of 16 analog inputs
    • ability to access all four channels on each ADC
    • continuous and single conversion modes
    • all eight Data Rate settings available
    • ability to change comparator polarity
    • ability to modify the comparator queue
    • all programmable gain amplifier modes available
    • ability to operate in single-ended mode or differential mode**
    • ability to return either the input data as raw, as a percentage, or as voltage
    • very easy to configure and run; most users won't have to set any parameters or call any configuration methods; the defaults are very sane
    • the documentation is extensive and detailed, but easy to understand and laid out reasonably well (I hope)
    • it has zero dependencies, Perl or otherwise (well, other than the need for a C compiler for the XS file)
    • works with any ADS1xxx model, and will properly bit-shift according to whether we're on a 16-bit wide resolution model, or a 12-bit one

    ** - single-ended mode is the measurement of voltage of a single input relative to ground. Differential mode retrieves the voltage difference between two separate inputs.

    Here's a basic example, and for the most part, exactly how I use the software. Say I have a moisture sensor connected to analog input A0 (0 as far as the software is concerned) and I want to get the moisture level from it:

    use warnings; use strict; use RPi::ADC::ADS; my $adc = RPi::ADC::ADS->new; my $v = $adc->volts; my $p = $adc->percent; my $r = $adc->raw;

    Volts is a floating point number, percent is a float chopped at .2f and raw is the raw 16-bit unsigned int.

    If you have more than one channel active at a time, specify which channel you want to fetch from:

    # A0, A1 and A3 input channels for (0, 1, 3){ print $adc->percent($_) ."\n"; }

    All configuration register options can be changed on the fly, as they each have their own setter/getter. Say you are using two inputs (eg: A0 and A3) as single-ended inputs and at one point in code, you need to retrieve the value of the difference in levels between them. The documentation has a map for parameter value to hardware functionality for all settings. All fetch methods allow you to send in the channel to retrieve on the fly, so we don't have to do anything special here. Per the map in the docs above, either of these will work:

    my $diff_a0_a3 = $adc->percent(5); # or $adc->channel(5); my $diff_a0_a3 = $adc->percent;

    The software is quite complete, and I have tested the vast majority of the configuration settings. I'm about 85% test coverage so there's a bit more work to do there, but I digress.

    My next project is to write a Perl distribution for a BMP 180 barometric and altimiter sensor which I just bought and soldered yesterday, and an MCP3008 analog-digital converter. The 3008 has 10 input channels whereby the ADS only has four, but the ADS has 12-bit or 16-bit of resolution accuracy, where the MCP3008 only has 10-bit, so I decided I'd write code for both.

    See also:

    WiringPi::API, my original and nearly feature complete wrapper for the WiringPi libraries.

    RPi::WiringPi, OO interface for the above wrapper with error detection, safe exit on unexpected terminations, and more.

    RPi::DHT11, module to access the DHT11 temperature and humidity sensor.

    App::RPi::EnvUI, my Dancer2 and jQuery one-page app for indoor grow room control (not yet fully completed).

    RPi::WiringPi::Constant, module that contains commonly used names in the Raspberry Pi/electrical/electronics realm.

Log In?

What's my password?
Create A New User
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (6)
As of 2017-01-16 17:15 GMT
Find Nodes?
    Voting Booth?
    Do you watch meteor showers?

    Results (151 votes). Check out past polls.