在perl

时间:2016-07-06 03:55:18

标签: perl memory-management

我有一个代码来解析2000个csv文件并根据它们构建哈希值。 代码运行良好,快速,直到它读取~100个文件,然后它以蜗牛的​​速度运行

消耗的内存约为1.8 GB未压缩 目标是从csv文件构建全局哈希%_hist。

文件大小介于20KB到30 MB之间 操作系统是带有12 GB RAM的Mac 64位perl 5.18

我已经将函数中的每个变量创建为“my”,期望在函数退出后释放它。 唯一持久的全局变量是%_hist

有没有办法提高性能?

foreach my $file (@files){
    iLog ("Checking $file");

        $| = 1;  #flush io
        return error("File $file doesn't exist") if not -e $file;

        my @records = readCSVFile($file);   #reads csv file to 2d array and returns the array
        my @formatted_recs;                

        foreach $rec ( @records ){

            my ($time,$c,$user_dst,$client,$ip_src,$first_seen,$last_seen,$first_seen_time,$last_seen_time,$device_ip,$country,$org,$user_agent) = @$rec;



            my @newrec = ($time,$c,$client,$first_seen,$last_seen,$ip_src,$user_agent,$device_ip,$country,$org);

            next if $time =~ /time/i;       #Ignore first record
            push(@formatted_recs, \@newrec);
        }

        baselineHistRecords(@formatted_recs);
}

sub readCSVFile{
my $file = shift;


my @data;
open my $fh, '<', $file or return error("Could not open $file: $!");

my $line = <$fh>;           #Read headerline
my $sep_char = ',';
$sep_char = ';' if $line =~ /;"/;
$sep_char = '|' if $line =~ /\|/;

my $csv = Text::CSV->new({ sep_char => "$sep_char" });
push (@data, split(/$sep_char/, $line) );
while( my $row = $csv->getline( $fh ) ) { 
    push @data, $row;
}
close $fh;
return @data;
}


sub baselineHistRecords{
my @recs = @_;

undef $_ for ($time,$c,$client,$first_seen,$last_seen,$ip_src,$user_agent,$device_ip,$country,$org) ;
undef $_ for (%device_count, %ua_count,  %location_count, %org_count );
my ($time,$c,$client,$first_seen,$last_seen,$ip_src,$user_agent,$device_ip,$country,$org) ;

my %loc = {}; my %loc2rec = {};
my %device_count = {}; my %ua_count = {}; my %location_count = {}; my %sorg_count = {};
my $hits=0;
my @suspicious_hits = ();


foreach $rec (@recs){
    my $devtag=''; my $os = ''; 

    my @row = @{$rec};
    ($time,$c,$client,$first_seen,$last_seen,$ip_src,$ua,$device_ip,$country,$org) = @row;
    veryverbose("\n$time,$c,$client,$first_seen,$last_seen,$ip_src,$user_agent,$device_ip,$country,$org");

    next if not is_ipv4($ip_src);

    ###### 1. Enrich IP
    my $org = getOrgForIP($ip_src);
    my ($country_code,$region,$city) = getGeoForIP($ip_src);
    my $isp = getISPForIP($ip_src);
    my $loc = join(" > ",($country_code, $region));
    my $city = join(" > ",($country_code, $region, $city));
    my $cidr = $ip_src; $cidr =~ s/\d+\.\d+$/0\.0\/16/; #Removing last octet
#   my $packetmail = getPacketmailRep($ip_src);
#   push (@suspicious_hits, "$time $c $client $ip_src $ua / $packetmail") if $packetmail !~ /NOTFOUND/;

    ##### 2. SANITIZE


    $ua = cannonize($ua);

    $devtag = $& if $ua =~ /\([^\)]+\)/; 
    @tokens = split(/;/, $devtag);
    $os = $tokens[0];
    $os =~ s/\+/ /g;$os =~ s/\(//g;$os =~ s/\)//g;
    $os = 'Android' if $os !~ /Android/i and $devtag =~ /Android/i;
    $os = "Windows NT" if $os =~ /compatible/i or $os =~ /Windows NT/i;


    $_hist{$client}{"isp"}{$isp}{c} += 1;
    $_hist{$client}{"os"}{$os}{c} += 1;
    $_hist{$client}{"ua"}{$ua}{c} += 1 if not is_empty ($ua); 
    $_hist{$client}{"ua"}{c} += 1 if not is_empty ($ua);        #An exception marked since all logs doesn't have UA values
    $_hist{$client}{"loc"}{$loc}{c} += 1; 
    $_hist{$client}{"org"}{$org}{c} += 1;
    $_hist{$client}{"cidr"}{$cidr}{c} += 1;
    $_hist{$client}{"city"}{$city}{c} += 1;
    $_hist{$client}{"c"} += 1;

    $hits = $hits + 1;

    print "." if $hits%100==0;
    debug( "\n$ip_src : $os $loc $isp $org $ua: ".$_hist{$client}{"os"}{$os}{c} );
}

print "\nHITS: $hits";
return if ($hits==0);       #return if empty

printf("\n######(( BASELINE for $client  (".$_hist{$client}{c} ." records) ))#######################\n");   
foreach my $item  (qw/os org isp loc ua cidr/){


    debug( sprintf ("\n\n--(( %s: %s ))-------------------------------- ",$client,uc($item)) );

    ## COMPUTE Usage Percent
    my @item_values = sort { $_hist{$client}{$item}{$b}{c} <=> $_hist{$client}{$item}{$a}{c} } keys %{ $_hist{$client}{$item} };

    my @cvalues = ();
    foreach my $key ( @item_values ){   

        my $count = $_hist{$client}{$item}{$key}{c};
        my $total = $_hist{$client}{c};

        $total = $_hist{$client}{"ua"}{c} if $item =~ /^ua|os$/i and $_hist{$client}{"ua"}{c};      #Over for User_agent and OS determination as all logs doesn't have them


        my $pc = ceil(( $count / $total ) * 100) ;


        debug ("Ignoring empty value") if is_empty($key); # Ignoring Empty values 
        next if is_empty($key);

        $_hist{$client}{$item}{$key}{p} = $pc ;

        push (@cvalues, $pc);
        #printf("\n%3d \% : %s",$pc,$key) if $pc>0;
    }

    ## COMPUTE Cluster Centers
    my @clustercenters =  getClusterCenters(3,@cvalues);
    my ($low, $medium, $high) = @clustercenters;
    $_hist{$client}{$item}{low} = $low;
    $_hist{$client}{$item}{medium} = $medium;
    $_hist{$client}{$item}{high} = $high;

    my %tags = ( $low => "rare", 
                 $medium => "normal", 
                 $high =>"most common",
                 );
    debug ("\n(Cluster Centers) : $low \t$medium \t $high\n");
    foreach my $key ( @item_values ){   
        next if is_empty($key);             
        my $pc = $_hist{$client}{$item}{$key}{p};                   
        $_hist{$client}{$item}{$key}{tag} = $tags{ closest($pc, @clustercenters) };

        debug( sprintf("\n%3d \% : %s : %s",$pc, $_hist{$client}{$item}{$key}{tag} ,  $key) );
    }
}

printf("\n\n###################################\n");

saveHistBaselines();

}

谢谢, UMA

1 个答案:

答案 0 :(得分:1)

这是代码审查的更多问题。

  1. 代码中有大量完全无用的复制。例如:为什么你要将数据从@$rec复制到@newrec$rec@row?为什么要从readCSVFile返回简单的行列表而不是引用?
  2. 你真的不需要在内存中读取整个文件然后对其进行处理 - 你可以逐行处理数据并在完成后立即丢弃它。