tomw1975 has asked for the wisdom of the Perl Monks concerning the following question:

This may be some what long winded and complex, but the basic issue here is a memory leak somewhere in my C Perl interface.

A little background. I have a Perl database that has a basic list of MQ Queue names and individual users. The process that is causing issues is taking information and routing it from the user to the Queue. From what I have seen my embedding is working fine apart from this memory problem. We are running on a AIX platform under tuxedo (Yucky I know but you got to work with the tools they give you!) The Embedding code looks like this... 

#include <EXTERN.h>
#include <perl.h>
#include <stdio.h>
#include <stdlib.h>


static PerlInterpreter *my_perl;
int count;
int counter;
char *queue;
char *tempPop;
char *temp;
int i = 0;


EXTERN_C void xs_init _((void));

EXTERN_C void boot_DynaLoader _((CV* cv));

EXTERN_C void
xs_init(void)
{
    char *file = __FILE__;
    dXSUB_SYS;

    /* DynaLoader is a special case */
    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}


/*********************************************************************
+*******/
/* PERL Database interface subroutine, should return an array of queue
+ names*/
/*********************************************************************
+*******/
Perldatabase(char pseudo [6], char *queue)
{

    dSP;
    ENTER;
    SAVETMPS;
    PUSHMARK (SP);
    XPUSHs (sv_2mortal (newSVpv (pseudo,6)));
    PUTBACK;
        perl_call_pv("database", G_ARRAY);
    SPAGAIN;
    count = POPi;
    temp=queue;
    while (count !=0)
    {
    tempPop = POPp;

    memcpy (temp, tempPop, 10);
        count--;
        temp = temp+10;
    }
    



    PUTBACK;
    FREETMPS;
    LEAVE;
}



char* interface(char pseudo[6], char *queue)
{

char *my_argv[] = { "", "dataquery.pl"};
my_perl = perl_alloc();
perl_construct(my_perl);
perl_parse(my_perl, xs_init, 2, my_argv, (char **)NULL);

perl_run(my_perl);

Perldatabase(pseudo, queue);

perl_destruct (my_perl);
perl_free(my_perl);

return (queue);

}

[download]
And the perl script running looks like this
#!/usr/bin/perl
use SDBM_File;
use POSIX;

sub database 
{
    my ($pseudo) = @_;
    
    %dbm;
    $db_file = "CTIC.dbm";
    tie %dbm, 'SDBM_File', $db_file, O_RDWR, 0;    #open read only

    @list=split ("__",$dbm{"$pseudo"});
    
        $count = 0;
    
        foreach $item(@list)
        {
            $queue1 = $item;
            $count++;
        }

    untie %dbm;
    @list2 =(@list,$count);
    
    return @list2;
        
    
}

[download]
Now I am by no means a Perl expert - this is my first Perl venture, but is there anyway to see what is leaking memory? Anyway to fix it? Anything obvious that you guys see? Any tools out there to help with this sort of thing? Anything????

Note I believe we are still running on 5.00503 if that makes any difference to this???

Many thanks for your time in advance, I apologise for the many questions, any insight would be greatly appricated.

Tom

Replies are listed 'Best First'.
Re: Memory leak issue with Embedded Perl
by dash2 (Hermit) on Jul 24, 2003 at 23:30 UTC
    Well, I am by no means a C expert. Actually, I am by no means a Perl expert either. But let it pass. My one guess would be: your Perl code doesn't seem to be using my very much. Variables like %dbm and @list2 aren't lexically scoped with my so they will hang around after you exit the subroutine. Which you probably don't want, and might be causing the memory leak.

    And you almost definitely want to put use strict; at the top of your Perl. That will complain about unscoped global variables, and a lot of other things, and enforce good code discipline.
    A massive flamewar beneath your chosen depth has not been shown here

[reply]
[d/l]
[select]
      Thanks I will take a look further into the  my function. The  use strict is also a good suggestion I will add that and see if it helps. This database subroutine only gets called once everytime we go through the process - would the memory still be hanging around even though we have effectively run the script and then terminated it? Or am I working under an incorrect assumption?.... Certainly wouldn't be the first time!!
[reply]
[d/l]
[select]
        If the process truly is exiting then yes, the memory will be freed. This isn't a daemon? And while this does not directly address the issue of leaking memory but a couple other observations.
        1. Your foreach loop seems to contain a useless assignment ($^W=1 would expose that).
        2. There must be a C library for handling DBM files, such as http://www.sleepycat.com

        --
        I'm not belgian but I play one on TV.

[reply]
Re: Memory leak issue with Embedded Perl
by tomw1975 (Sexton) on Jul 25, 2003 at 17:02 UTC
    Ok added  use strict and added all the  my statements and still getting the same the memory problems....
[reply]
[d/l]
[select]
      This might work - and more clearer to understand ( UNTESTED ) 
      #!/usr/bin/perl

# Standard stuff to catch errors
use strict qw(subs vars refs);            # Make sure we can't mess up
use warnings qw(all);                # Enable warnings to catch errors

# Other Stuff
use SDBM_File;
use POSIX;

sub database {
    my ($pseudo) = @_;

    # Declare our variables
    my %dbm;
    my $db_file = "CTIC.dbm";

    # Tie the dbm with the file, opening it read-only
    tie %dbm, 'SDBM_File', $db_file, O_RDWR, 0;

    # Get the list
    my @list = split( "__", $dbm{ $pseudo } );

    # Get rid of the dbm
    untie %dbm;

    # Add the count to the end of the list
    push( @list, scalar( @list ) );

    # Return the list
    return @list;
}

      [download]
[reply]
[d/l]
        I agree that is much easier to understand - I implemented the changes and still get the same issue. I am starting to think it is more to do with the XS interface than the .pl file itself. The suspicious line is the  newXS statement.... what does this do with memory??

        one other thing - I was unable to add warnings to my code, I will have to try and find out why I dont have that on the system.....

        Thanks for the effort though - this problem is proving tough to answer.

        Tom
[reply]
[d/l]

Back to Seekers of Perl Wisdom