Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re^2: ithreads memory leak

by DNAb (Novice)
on Apr 09, 2015 at 16:27 UTC ( #1122969=note: print w/replies, xml ) Need Help??


in reply to Re: ithreads memory leak
in thread ithreads memory leak

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

Replies are listed 'Best First'.
Re^3: ithreads memory leak
by BrowserUk (Pope) on Apr 09, 2015 at 17:41 UTC

    First:Ignore anything and everything sundialsvc4 says. He has a proven track record of meaningless, misdirected & pure malicious posts on subjects he has provably no knowledge or understanding of. And in particular, threads.

    then kill the walking timer,

    The fundamental problem with your code is this:

    #! perl -slw use strict; use threads; sub sleeper { print "thread started; sleeping"; $SIG{'KILL'} = sub { print "Thread dieing"; threads->exit(); }; sleep( 1000 ); print "Thread dieing"; threads->detach; } my $t = threads->new( \&sleeper ); sleep 5; print "Killing thread"; $t->kill( 'KILL' )->detach; print "thread status: ", $t->error(); sleep 100 while 1;

    Run that code and watch the process (top or whatever). It immediately creates a thread that just sleeps for a thousand seconds. The main thread then waits for 5 seconds and then (attempts to) kills the sleeping thread. But the thread never sees the "signal" ... until it finishes sleeping.

    This is because those "signals" aren't real signals; but some home-brewed simulation of them that cannot even interrupt a sleep. They (the pseudo-signals), should never have been added to the threads api; and they should never be used!

    And that explains the "memory growth" problem; you are expecting these threads to go away when before you start their replacements; but they simply won't.

    And that's a problem for your architecture which is built around that premise.

    I have 3 solutions for you: one is a quick fix; and the other two will required fairly extensive changes to your program.

    (But its my dinner time right now, so I'll detail them in a while. I just wanted to warn you to ignore sundialsvc4 who has never posted a single line of working code here. Be warned!)


    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". I'm with torvalds on this
    In the absence of evidence, opinion is indistinguishable from prejudice. Agile (and TDD) debunked

      Ah I see this caveat noted in the thread docs now, thank you for clearing this up.

      I'm happy to listen to any suggestions you can offer (when you have free time of course!), and I'm willing to put work into this, assuming it's near my level of competence.

      Again, thanks!

        I said 3 suggestion, but one of them was too complicated to merit discussion.

        1. So first the "right way" to do it.

          Your walktimer thread sub becomes something like this:

          sub walktimer { ## The queue handle is passed in when the thread is started my $Q = shift; #Sleep for 180 seconds, upon completion execute SQL to change OK_O +PEN back to all zero for $showcasenum ## A hash to remember when things time out. my %when; ## wake up once per second while( sleep 1 ) { ## while there are showcase numbers on the queue while( $Q->pending ) { ## grab the one at a time my $showcasenum = $Q->dequeue(); ## Calculate when the timeout should occur, ## and add the showcase number to the hash to be dealt wit +h at that time push @{ $when{ time() + $walktime } }, $showcasenumber; + } ## find any times that have expired (earlier than now!) for my $time ( grep{ $_ < time() } keys %when ) { ## And for each showcase number scheduled at that time for my showcasenum ( @{ $when{ $time } } ) { ## Do your db stuff my $dbh = DBI->connect('dbi:mysql:alarm:databasehost', +'username','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 $s +ql: $dbh->errstr\n"; $sth->execute($showcasenum) or die "SQL Error: $DBI::e +rrstr\n"; $dbh->disconnect; } ## and remove the expired time from the hash delete $when{ $time }; } } }

          I hope the comments make it clear, but basically, instead of starting a new thread for each timeout, you start one thread and pass it a handle to a queue.

          Then when you would have started a new walktimer thread, you simply post the showcase number to that queue. Ie this:

          elsif( $okopen == 1) { #Kill the walk timer if it is running, someone opened +the showcase legit debug("Killing walking timer and starting open timer, +authorized user opened showcase $showcasenum"); if( $walkthread[$showcasenum] && $walkthread[$showcase +num]->is_running() && !$walkthread[$showcasenum]->is_detached) { $walkthread[$showcasenum]->kill('KILL')->detach(); } $openthread[$showcasenum] = threads->create(\&opentime +r, $showcasenum, $opentime, $showcasedesc); }

          becomes this:

          elsif( $okopen == 1) { $Qwalktimer->enqueue( $showcasenum ); }

          You do the same thing for your opentimer sub thread.

          Now, instead of starting a new thread each time(r:), and having to track them, and kill them if they still exist; before starting a new one; you:

          1. Create 2 queues:

            One for opentimers and one for walktimers.

          2. Create (and detach) two threads at the start of the program.

            Fire and forget. They'll go away when your main thread does.

          3. You send (queue) instructions to them and they take care of it at the appropriate time.

          Two, long running threads that take instructions and do what's required. No memory growth.

        2. Now, the "quick fix option". Modify your walktimer this way:
          sub walktimer { #Sleep for 180 seconds, upon completion execute SQL to change OK_O +PEN back to all zero for $showcasenum my $showcasenum = $_[0]; debug("Launched walking timer thread for $showcasenum"); $SIG{'KILL'} = sub { threads->exit(); }; my $count = $walktime; sleep( 1 ) while --$count; ### Wake once per second for $walktime +seconds to allow the "signal handler" to respond to any pending "sign +als". if( threads->is_detached()) { threads->exit(); } my $dbh = DBI->connect('dbi:mysql:alarm:databasehost','username',' +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->er +rstr\n"; $sth->execute($showcasenum) or die "SQL Error: $DBI::errstr\n"; $dbh->disconnect; debug("Walking thread for $showcasenum is expiring..."); threads->detach(); }

          Ditto for opentimer(). And that should allow your current architecture to work. (I don't like it but ... its your code :)

        If you choose option 1 and need further help, yell and I'll try to modify a copy of your code and post it, but I'm not going to waste the effort if you choose option 2 :)


        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". I'm with torvalds on this
        In the absence of evidence, opinion is indistinguishable from prejudice. Agile (and TDD) debunked

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1122969]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (3)
As of 2019-12-07 18:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Strict and warnings: which comes first?



    Results (162 votes). Check out past polls.

    Notices?