Hello Monks, I come seeking wisdom :) I have created the below script to essentially, pull some DB data and using that data make API calls to a webservice -- It seems this script exhausts memory/swap after running for 5 - 10 minutes. The DB call returns 10,000 devices that need to be deleted... I can't seem to find where the possible memory leak exists, could you tell me if this a job for Threads or if I should be looking else where(currently reveiwing Fork::ParallelManager)? I feel, this script should be able to knock this out no problem, but alas, this is not the case... It doesn't seem to matter how many threads I configure for MAX, 2-25 I have tried so far and each time this script ends with "Killed" Watching TOP on the system running, with each iteration I can see MEM usage creep up to 80-85% and SWAP nearly exhausted... As you can see, Im logging my work and I can see that Im able to get through roughly 1,000 deletes before the "Killed" message.. any ideas?! 

#!/usr/bin/perl

use strict;
use warnings;
use DBI;
use Data::Dumper;
use Getopt::Long;
use threads;
use LWP::UserAgent;


my $version = '3.0';
my $build   = '07302015';
my $debug     = "";
my $maxThreads = '25';
my $countLimit     = '0';
my $deleteLimit = '10000';
my $environment = "dev";
my $report_filenme = "deletedDevices";
my @row;
my $deviceLogDIR;
chomp (my $reportDate = `date +\%Y\%m\%d`);
my @deletedDevices;
my %active_threads = ();

#Config Output Options
my $output         = CWM_configDelete->get_output();
my $date         = "$output->{date}";
my $out_dir     = "$output->{output_dir}";
   chomp ($date);

#Config Curl Options(Pulling these from a config.pm file I created as 
+we have multiple environments)
my $api_user     = CWM_configDelete->get_api();
my $api_creds     = "$api_user->{user}:$api_user->{pass}";

my $get_env     = "get_$environment";
my $cwm_cfg     = CWM_configDelete->$get_env();
my $cwm_url     = $cwm_cfg->{url};
my $cwm_host     = $cwm_cfg->{host};
my $cwm_user     = $cwm_cfg->{user};
my $cwm_pass     = $cwm_cfg->{pass};
my $cwm_db         = $cwm_cfg->{DB};

#CMD Line Options
GetOptions ("l:s"     => \$deleteLimit,
            "e:s"      => \$environment,
            "t:s"      => \$maxThreads,
            'debug'   => \$debug);

#####MAIN#####
#Connect to the DB
my $dbh = DBI->connect("DBI:mysql:database=$cwm_db;host=$cwm_host","$c
+wm_user","$cwm_pass", {'RaiseError' => 1});

#Prepare SELECT statement
my $sth = $dbh->prepare("SELECT cmt.serialNumber FROM Device d JOIN Cw
+mpManagedTrait cmt on (d.cwmpManagedTrait_id=cmt.id) WHERE cmt.lastin
+form < 1000*UNIX_TIMESTAMP(DATE_SUB(now(),INTERVAL 90 DAY)) limit $de
+leteLimit");

#Execute Select 
$sth->execute();

# THREADED

###Parse Fetch and execute DELETE
while (@row = $sth->fetchrow_array )
{
    ###Create and Run threads
    $active_threads{@row} = threads->create (\&deleteDevice, @row);

    ###Limit running threads
    while(scalar threads->list(threads::running) >= $maxThreads)
    {
        foreach my $th_key(keys %active_threads)
        {
            next unless($active_threads{$th_key}->is_joinable());
            $active_threads{$th_key}->join();
            delete($active_threads{$th_key});
        }
        sleep(1);
    }
}
###Thread cleanup
foreach (threads->list()) { $_->join(); }


### SUBS ###
sub deleteDevice($)
{
    my $deviceSN = shift;
    my $full_url = "https://$api_creds\@$cwm_url$deviceSN";
    &debug("CMD: $full_url");

    my $threadCount = scalar threads->list(threads::running);
    #print "Current Thread Count: $threadCount\r";

    ## Get current subscriber info
    my $ua = LWP::UserAgent->new(
            #ssl_opts => { verify_hostname => 0, SSL_verify_mode => 0x
+00 }
    );
    $ua->agent("Device Deletion");
   
    my $req = HTTP::Request->new(DELETE => $full_url);
    $req->content_type('application/x-www-form-urlencoded');

    my $res = $ua->request($req);
    if($res->is_success)
    {
        &logDeviceDetails("$deviceSN -- Delete Successful");
                        
    }
    else
    {
        &logDeviceDetails("$deviceSN -- Delete Failed: " . $res->statu
+s_line . " - " . $res->content);

    }

}

sub logDeviceDetails(@)
{    # Log Script actions
    my @deviceLogs = @_;
    chomp (my $TS = `date +\%H:\%M:\%S`);
    my $logoutFile = '/var/tmp/CWM/del_reports';

    # Append File name
    $deviceLogDIR = "$logoutFile" . "/subDELreport" . '_' . "$reportDa
+te";

    # Create log file 
    open  FILE, ">>", "$deviceLogDIR" or die "Failed to open $deviceLo
+gDIR: $!";
    print FILE  for "$TS: @deviceLogs\n"; #update file with edits made
    close FILE;
}

sub debug(@)#Spit Info
{
    my @pass_data = @_;
    chomp (my $TS = `date +\%H:\%M:\%S`);

    if ($debug)
    {
        print for "DEBUG:$TS  @pass_data\n";

    }

}

[download]

In reply to Perl Threads by Monkless

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, details, 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, summary, 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.