一个关于perl out of memory的问题

[wish4sun]

我写了一个导数据用的perl程序，运行的时候刚开始还可以，然后到了某一条数据突然就不再继续运行了，然后我查看内存占用情况，就会一直增长，一直耗光内存，然后提示out of memory
,如果是我的其中一个变量持续增长应该是改程序占用内存也是持续增长的，可是我观察内存占用情况，刚开始该程序一直维持在一个很低的情况，直到遇到某一条数据后，就开始一直增长了，请各位大侠们帮帮我，我死活找不出原因，我是perl新手，不太会debug。谢谢各位了。

下面是源代码，处于公司保密目的，我将其中的接口和数据库IP给替换成xxxxxx了，请各位多包涵！

#!/usr/bin/perl -w
use strict;
use warnings;
use DBI;
use XML::Smart;
use Data::Dumper;
use Encode qw/encode decode/;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use MIME::Base64 qw(encode_base64 decode_base64);
use LWP::UserAgent;
require "db.pl";
my $dbh =  &get_joy_db;
#my $ii = 0;
#my $jj = 0;
my %db_joyid;

my %all_urls = ("电视剧"=>"http://xxxxx/get_list.php?channelid=58",
                                        "电影"=>"http://xxxxx/get_list.php?channelid=51",
                                        "播客"=>"http://xxxxx/get_video_list.php?channelid=1",
                                        "娱乐"=>"http://xxxxx/get_video_list.php?channelid=3");


while(my ($cat, $url) = each %all_urls){
        my @content_url = return_url_update($url);
        foreach my $u (@content_url) {
                print $cat,$u."\n";
                my $XML = XML::Smart->new( $u, 'XML::Smart::Parser' );
                my @items = reverse(@{ $XML->{root}{videolist}{video}});
                foreach my $item (@items) {
                        print "\n\n\n";
                        my $title = $dbh->quote(&encode("GBK",$item->{title}));
                        #print $title."\n";
                        my $id = &encode("GBK",$item->{id});
                        my $intro = $dbh->quote(&encode("GBK",$item->{desc}));
                        my $tags = $dbh->quote(&encode("GBK",$item->{tag}));
                        my $play_url = &encode("GBK",$item->{play_url});
                        my $src_image = &encode("GBK",$item->{img_url});
                        my $time = &encode("GBK",$item->{totaltime});
                        my $image = handleJoyPic($src_image,"joy");
                        $image = "http://cnimg.realnetworks.com.cn/guide/mdb/".$image;
                        my ($curdate,$curtime)=get_time();
                        print $cat."===>".$title."=>".$id."=>".$image."\n";
                        my $sql_chk = "select joyid from joy where joyid = $id";
                        my $sth_chk = &execsql($dbh, $sql_chk);
                        
                        while ( my ($joyid) = $sth_chk->fetchrow() ) {
                                $db_joyid{$joyid} = $joyid;
                        }
                        if ($db_joyid{$id}) {
                                print "\n\t"."数据库数据重复:".$title."\n";
                                #$jj++;
                        }else{
                                my $sql_insert = "insert into joy (`title`,`intro`,`tags`,`image_1`,`src_image`,`joyid`,`category`,`length`,`createdate`,`createtime`,`playurl`) values ($title,$intro,$tags,'$image','$src_image','$id','$cat','$time','$curdate','$curtime','$play_url');";
                                my $sth_insert = &execsql($dbh, $sql_insert);
                                print  "\n\t"."数据插入成功:".$title."\n";
                                $sth_insert->finish();
                                #$ii++;
                        }
                        $sth_chk->finish();
                        undef %db_joyid;
                }
        }
}
#print "总共插入$ii条数据，另有$jj条数据重复！";

sub get_time {
        my ($sec,$min,$hour,$day,$mon,$year)=localtime(time);
        $sec  = ($sec < 10)?"0$sec":$sec;
        $min  = ($min < 10)?"0$min":$min;
        $hour = ($hour < 10)?"0$hour":$hour;
        $day  = ($day < 10)?"0$day":$day;
        $mon  = ($mon < 9)?"0".($mon+1):($mon+1);
        $year += 1900;
        return "$year-$mon-$day", "$hour:$min:$sec";
}

sub get_joy_db {
    my ( $db_host, $db_name, $db_user, $db_pwd, $db_port, $db_timeout ) =
      ( "xxxxxxxxxxxxxxx", "movie", "root", "xxxxxxxxx", 9002, 0 );
    my $dbh =
      &db_open( $db_host, $db_name, $db_user, $db_pwd, $db_port, $db_timeout );
    return $dbh;
}

sub file_name {
    my ($filepath) = @_;
    my $pos = rindex( $filepath, "/" );
    if ( $pos == -1 ) {
        return $filepath;
    }
    else {
        return substr( $filepath, $pos + 1 );
    }
}

sub md5_filename{
        my ($filename) = @_;
        #print $filename;
        my $pos = rindex($filename,".");
        #print $pos."\n";
        my $prename = substr($filename,0,$pos);
        my $extname = substr($filename,$pos+1);
        return md5_hex($prename).".".$extname;
}

sub handleJoyPic {
    my ($arg,$partner) = @_;
    if ( $arg !~ /http:\/\/.*/isg ) {
        return "";
    }
    my $img_filename = file_name($arg);
        my $md5_filename = md5_filename($img_filename);
    my $hash         = md5_hex($arg);
    my $len          = length($hash);
    my $ascii        = 0;
    for ( my $i = 0 ; $i < $len ; $i++ ) {
        $ascii += ord( substr( $hash, $i, 1 ) );
    }
    my $path = sprintf( "%d/%d", $ascii % 128, $ascii % 53 );
    my $fixed_img_path = "$partner/$path/$md5_filename";
    my $cmd = "mkdir -p  $partner/$path/;wget $arg;mv $img_filename $partner/$path/$md5_filename";
    $cmd .=";/usr/local/bin/rsync -vtp --timeout=120 -R $fixed_img_path xxxxxxxxx::img_mdb";
    #print $cmd."\n";
    system("$cmd");
    #print $fixed_img_path."\n";
    return $fixed_img_path;
}

sub return_url_update{
        my ($url,$num) = @_;
        if (!$num) {
                $num = 50;
        }
        $url = $url."&start=0&num=".$num;
        return $url;
}

[fibbery]

在主程序的各个循环的开始，把循环变量打印出来，观察一下。

[fibbery]

你该确定，在执行那段程序时，导致内存不断的增加。

[iambic]

别人直接运行你这段代码就能重现你的问题吗？

[wish4sun]

我这个代码有读写数据库的操作和调用合作方数据接口，所以不能直接运行啊，数据库和接口相关信息我都给隐去了。我觉得就是可能是我哪个循环或者某个变量没弄好，导致没有释放内存，但是我实在是查不出来是哪儿的问题了，所以在这里求答案。

[iambic]

“直到遇到某一条数据后”是哪一条数据？自己仔细看看这条数据有什么特别，对程序流程有什么影响。
也可以自己把代码一行行注释掉重新运行，看看哪些代码影响内存运行。
你自己也要对你的程序有概念，这个程序在运行过程中的内存使用应该是什么情况，有哪些状态是持续增长，那些是使用后就可以很快回收的。有没有很大的数据，有没有循环引用。

[wish4sun]

这一条数据有的时候是可以读过去的，所以我认为数据本身并没有问题，假如我将那四个数据接口分别执行，那么就可以读过去，但是放到一个哈希表里面去循环，就不行了。说实话，我对内存什么的没什么概念，而且又是perl的新手，不太会调试perl，所以才到这里问一下的。。。倒不是我不想自己找，我都找了2天了，还是没找到。。。

[iambic]

一条数据就out of memory？有没有死循环或者递归？CPU占用情况呢？

[wish4sun]

我发现在解析XML其中的几条数据的时候就会停止不动，造成out of memory，但是我实在看不出来那条数据到底哪儿有问题，不知道perl有没有检查xml数据方面的函数

[iambic]

我觉得你要做的是尽量把代码删减。越少越好。最后只剩下几行代码，问题就比较清楚了。而且因为代码已经删减得没什么用处，可以完整贴出来给其他人重现了。别人手头根本重现不出来你的问题，帮不上什么忙。

[我2我骄傲]

好多，懒的看了