Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

I see what you are both saying, I'm just not 100% sure how to make this code any different right now. It's somewhat unique, but it's still totally in beta so I'm fine with revisiting most aspects.

The use case is as follows: An assortment of showcases are alarmed. To access a showercase a user must press a function key on a keypad, this starts a timer which gives them up to three minutes to open the showcase. If the user doesn't open the showcase, update the database to require another key press, if the user does open the showcase update the point as open in the database and then kill the walking timer, and start the open timer. The open timer lets them keep the door open for ten minutes, if this timer expires then send an alert, otherwise when the user closes the door kill the open timer. I realize this is complicated, I'm trying to give anyone reading this thread an idea of why it is how it is.

Anyway, as promised here is the code:

(Fair warning, by anyone's standards it's probably ugly)

#!/home/username/perl5/perlbrew/perls/perl-5.20.2/bin/perl #######################################CONFIG######################### +################### #Time allowed for someone to walk to a showcase, system "rearms" after + timer expires my $walktime :shared; $walktime = 180; #Print debug information to console my $debugtoconsole = 0; #Print debug information to log my $debugtofile = 1; #Timeout between when calls from call buttons can be broadcast my $calltimeout = 60; ###################################################################### +################### use warnings; use threads; use threads::shared; use DBI; use Proc::Daemon; use strict; Proc::Daemon::Init; open(my $com, "/dev/ttyUSB0") || die "Error: Cannot read from serial p +ort : $!\n"; open(STDERR, ">/home/username/errorlog.txt") || die "Error: Cannot ope +n error log file: $!\n"; my $dbh = DBI->connect('dbi:mysql:alarm:databasehost','username','pass +word') or die "Connection Error: $DBI::errstr\n"; $SIG{INT} = sub { $dbh->disconnect; die;}; $SIG{TERM} = sub { $dbh->disconnect; die;}; $SIG{FPE} = sub { &alive; }; my %calls; my @walkthread; my @openthread; #On start check that all flags in the DB are set to their defaults &debug("Checking for records with incorrect init status"); my $sql = "select * from Showcases where PT_CLOSED = 0 OR OK_OPEN = 1 +OR OPEN_TIME != 600"; my $sth = $dbh->prepare($sql) or die "Can't prepare $sql: $dbh->errstr +\n"; $sth->execute or die "SQL Error: $DBI::errstr\n"; my @tbf; while (my @row = $sth->fetchrow_array()) { push(@tbf,$row[0]); } my $length = @tbf; if ($length == 0) { &debug("Found no records wirh an incorrect init status"); } else { &debug("Found $length records with an incorrect init status"); for(my $i=0;$i < $length; $i++) { &debug("Bad Record: $tbf[$i]"); $sql = "update Showcases set OK_OPEN=0, PT_CLOSED=1,OP +EN_TIME=600 WHERE PT_NUM = ?"; $sth = $dbh->prepare($sql) or die "Can't prepare $sql: + $dbh->errstr\n"; $sth->execute($tbf[$i]) or die "SQL Error: $DBI::errst +r\n"; } } #While able to read from the serial port while(<$com>) { chomp(my $msg = $_); &debug("Received on input: $msg"); if ($msg =~ /(\d\d\d)F\d/) { my $showcasenum = $1; &debug("We have received a function key"); $sql = "select * from Showcases where SC_NUM=? AND IS_ +BYPASSED = 1"; my @row = $dbh->selectrow_array($sql,undef,$showcasenu +m); if (!@row) { $sql = "select * from Showcases where SC_NUM=? +"; my @row = $dbh->selectrow_array($sql,undef,$sh +owcasenum); if (@row) { &debug("Setting all OK_OPEN flags to 1 + for $showcasenum"); $sql = "update Showcases set OK_OPEN=1 + WHERE SC_NUM = ?"; $sth = $dbh->prepare($sql) or die "Can +'t prepare $sql: $dbh->errstr\n"; $sth->execute($showcasenum) or die "SQ +L Error: $DBI::errstr\n"; #Start a thread to track the walking t +imer. if ($walkthread[$showcasenum] && $walk +thread[$showcasenum]->is_running() && !$walkthread[$showcasenum]->is_ +detached) { &debug("Key was previously pre +ssed, killing walk thread"); $walkthread[$showcasenum]->kil +l('KILL')->detach(); } $walkthread[$showcasenum] = threads->c +reate(\&walktimer, $showcasenum); } } else { &debug("Showcase $showcasenum is bypassed, not + taking action"); } } elsif ($msg =~ /(\d\d\d)C0/) { my $showcasenum = $1; &debug("We have recieved a contact not secure"); $sql = "select * from Showcases where SC_NUM=? AND IS_ +BYPASSED = 1"; my @row = $dbh->selectrow_array($sql,undef,$showcasenu +m); if (!@row) { &debug("Updating PT_CLOSED to 0 for $showcasen +um"); $sql = "update Showcases set PT_CLOSED=0 WHERE + SC_NUM=?"; $sth = $dbh->prepare($sql) or die "Can't prepa +re $sql: $dbh->errstr\n"; $sth->execute($showcasenum) or die "SQL Error: + $DBI::errstr\n"; $sql = "select * from Showcases where SC_NUM=? +"; my @row = $dbh->selectrow_array($sql,undef,$sh +owcasenum); my $showcasearea = $row[2]; my $showcasedesc = $row[3]; my $okopen = $row[4]; my $opentime = $row[6]; if ($okopen == 0) { &debug("Alarm triggered on showcase $s +howcasedesc in $showcasearea"); &mail('ic@localhost',"Showcase $showca +senum is in alarm","Showcase $showcasedesc is in alarm, IMMEDIATE ACT +ION REQUIRED!"); } elsif ($okopen == 1) { #Kill the walk timer if it is running, + someone opened the showcase legit &debug("Killing walking timer and star +ting open timer, authorized user opened showcase $showcasenum"); if ($walkthread[$showcasenum] && $walk +thread[$showcasenum]->is_running() && !$walkthread[$showcasenum]->is_ +detached) { $walkthread[$showcasenum]->kil +l('KILL')->detach(); } $openthread[$showcasenum] = threads->c +reate(\&opentimer, $showcasenum, $opentime, $showcasedesc); } } else { &debug("Showcase $showcasenum is bypassed, not + taking action"); } } elsif ($msg =~ /(\d\d\d)C1/) { my $showcasenum = $1; &debug("We have recieved a contact secure"); $sql = "select * from Showcases where SC_NUM=? AND IS_ +BYPASSED = 1"; my @row = $dbh->selectrow_array($sql,undef,$showcasenu +m); if (!@row) { if ($openthread[$showcasenum] && $openthread[$ +showcasenum]->is_running() && !$openthread[$showcasenum]->is_detached +()) { $openthread[$showcasenum]->kill('KILL' +)->detach(); &debug("Killing open timer thread for +$showcasenum"); } else { &debug("Open timer for $showcasenum is + not running, was never started, or it detached"); } $sql = "update Showcases set PT_CLOSED = 1, OP +EN_TIME=600, OK_OPEN=0 WHERE SC_NUM = ? AND IS_BYPASSED=0"; $sth = $dbh->prepare($sql) or die "Can't prepa +re $sql: $dbh->errstr\n"; $sth->execute($showcasenum) or die "SQL Error: + $DBI::errstr\n"; } else { &debug("Showcase $showcasenum is bypassed, not + taking action"); } } elsif ($msg =~ /LOWBAT/i) { &debug("We have recieved a low battery warning"); &mail('ic@localhost',"Low Battery","There is a low bat +tery warning"); } elsif ($msg =~ /(AR1|AR2|AR3|AR4)/) { &debug("We have received a request to add time"); my $area = $1; $sql = "select * from Showcases where AREA = ? AND OK_ +OPEN = 1"; $sth = $dbh->prepare($sql) or die "Can't prepare $sql: + $dbh->errstr\n"; $sth->execute($area) or die "SQL Error: $DBI::errstr\n +"; my @tbf; while (my @row = $sth->fetchrow_array()) { push(@tbf,$row[1]); } my $length = @tbf; if ($length == 0) { &debug("No showcases in area $area allowed to +have time extended"); } else { &debug("Adding time to $area"); $sql = "update Showcaes set OPEN_TIME = OPEN_T +IME + 900 WHERE AREA = $area AND OK_OPEN = 1"; $sth = $dbh->prepare($sql) or die "Can't prepa +re $sql: $dbh->errstr\n"; $sth->execute or die "SQL Error: $DBI::errstr\ +n"; for (my $i=0; $i<$length; $i++) { if ($openthread[$tbf[$i]] && $openthre +ad[$tbf[$i]]->is_running() && !$openthread[$tbf[$i]]->is_detached()) { &debug("Killing current open t +hread for $tbf[$i] and starting a new one"); $openthread[$tbf[$i]]->kill('K +ILL')->detach(); #start new thread with new $op +entime $sql = "select * from Showcase +s where SC_NUM = ?"; my @row = $dbh->selectrow_arra +y($sql,undef,$tbf[$i]); my $opentime = $row[6]; my $showcasedesc = $row[3]; $openthread[$tbf[$i]] = thread +s->create(\&opentimer, $tbf[$i], $opentime, $showcasedesc); } else { &debug("Open thread for showca +ses is already detached, not running, or was never started"); } } } } elsif ($msg =~ /(\d\d\d)CB/) { my $buttonnum = $1; &debug("We have received a call button press from $but +tonnum"); if (exists $calls{$buttonnum}) { &debug("Button $buttonnum previously pressed") +; my $timeadded = $calls{$buttonnum}; if((time() - $timeadded) >= $calltimeout) { delete( $calls{$buttonnum} ); $calls{$buttonnum} = time(); &debug("Timer expired for $buttonnum, +sending new page"); &mail('ic@localhost',"Call button $but +tonnum","Call button pressed"); } } else { $calls{$buttonnum} = time(); &debug("New button press for $buttonnum, sendi +ng page"); &mail('ic@localhost',"Call button $buttonnum", +"Call button pressed"); } } else { &debug("Received input that I don't understand"); } } close $com; sub opentimer { my $showcasenum = $_[0]; my $opentime = $_[1]; my $showcasedesc = $_[2]; &debug("Launched open timer thread for $showcasenum"); $SIG{'KILL'} = sub { threads->exit(); }; sleep($opentime); if (threads->is_detached()) { threads->exit(); } #Send email if timer runs through &mail('ic@localhost',"Showcase $showcasenum Left Open","Showca +se $showcasedesc has been left open for a long period of time. Invest +igation required."); my $dbh = DBI->connect('dbi:mysql:alarm:databasehost','usernam +e','password') or die "Connection Error: $DBI::errstr\n"; my $sql = "update Showcases set OPEN_TIME = 600, OK_OPEN = 0 W +HERE SC_NUM =?"; my $sth = $dbh->prepare($sql) or die "Can't prepare $sql: $dbh +->errstr\n"; $sth->execute($showcasenum) or die "SQL Error: $DBI::errstr\n" +; $dbh->disconnect; &debug("Open timer for $showcasenum is expiring, sending email + that showcase was left open..."); &mail('ic@localhost',"Showcase $showcasenum Left Open","Showca +se left open"); threads->detach(); } sub walktimer { #Sleep for 180 seconds, upon completion execute SQL to change +OK_OPEN back to all zero for $showcasenum my $showcasenum = $_[0]; &debug("Launched walking timer thread for $showcasenum"); $SIG{'KILL'} = sub { threads->exit(); }; sleep($walktime); if (threads->is_detached()) { threads->exit(); } my $dbh = DBI->connect('dbi:mysql:alarm:databasehost','usernam +e','password') or die "Connection Error: $DBI::errstr\n"; my $sql = "update Showcases set OK_OPEN=0 WHERE SC_NUM = ?"; my $sth = $dbh->prepare($sql) or die "Can't prepare $sql: $dbh +->errstr\n"; $sth->execute($showcasenum) or die "SQL Error: $DBI::errstr\n" +; $dbh->disconnect; &debug("Walking thread for $showcasenum is expiring..."); threads->detach(); } sub alive { my $bypassed; my $dbh = DBI->connect('dbi:mysql:alarm:databasehost','usernam +e','password') or die "Connection Error: $DBI::errstr\n"; my $sql = "select * from Showcases where IS_BYPASSED=1"; my $sth = $dbh->prepare($sql) or die "Can't prepare $sql: $dbh +->errstr\n"; $sth->execute or die "SQL Error: $DBI::errstr\n"; my @tbf; while (my @row = $sth->fetchrow_array()) { push(@tbf,$row[3]); } my $length = @tbf; if ($length == 0) { &debug("No showcases bypassed"); my $bypassed = "None"; } else { my $bypassed = join(', ', @tbf); &debug("Found showcases bypassed: $bypassed"); &mail('email1','System is Online',"This is an automati +cally generated message to show the PERL monitoring daemon is running +.\n\nBypassed Showcases: $bypassed"); &mail('email2','System is Online',"This is an automati +cally generated message to show the PERL monitoring daemon is running +.\n\nBypassed Showcases: $bypassed"); } $dbh->disconnect; } sub mail { use Email::MIME; use Email::Sender::Simple qw(sendmail); my ($to, $subject, $body) = @_; my $message = Email::MIME->create( header_str => [ From => $to, To => $to, Subject => $subject, ], attributes => { encoding => 'quoted-printable', charset => 'ISO-8859-1', }, body_str => $body, ); sendmail($message); } sub debug { use IO::Handle; open (my $log, ">>/home/username/log.txt") || die "Error: Cann +ot open log file: $!\n"; $log->autoflush(1); my $line = $_[0]; my ($sec,$min,$hour,$mday,$mon,$year)=localtime(time); my $timestamp = sprintf ( "%02d-%02d-%04d %02d:%02d:%02d",$mon ++1,$mday,$year+1900,$hour,$min,$sec); if ($debugtofile == 1) { print $log "$timestamp $line\n"; } if ($debugtoconsole == 1) { print "$timestamp $line\n"; } close $log; }


In reply to Re^2: ithreads memory leak by DNAb
in thread ithreads memory leak by DNAb

Title:
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 the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others avoiding work at the Monastery: (10)
    As of 2019-12-05 14:27 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Strict and warnings: which comes first?



      Results (151 votes). Check out past polls.

      Notices?