perl script eats all my PC memory...

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

I am trying to use a perl script , basically a file format converter, and regardless of the instance i throw at it, it always ends with a kill after all available memory has been taken...

this is the script...

 #!/usr/bin/perl

# use strict;

# Felde Roland <felderoland@chello.hu>
# 2005.09.04 Bugfixed
# 2006.07.12 Add versioncheck: can convert acis version 4 and version 
+7
# 2006.11.08. Can convert sat files with sequence-nr. New sequence det
+ection. 
# 2007.07.12 Add version 16

my $nr = 0; # Z&#65533;hler f&#65533;r die acis sequensen
my $mod = 0;
my $lines;
my @satseq;

@satfile = <STDIN>;
$satlength = @satfile;

# Aufbereitung der satfile ####################### 
$satseq[0]=$satfile[0];
$satseq[1]=$satfile[1];
$satseq[2]=$satfile[2];

$sorsz=3;
for ($i=3; $i<$satlength;$i++){
    $ln = $satfile[$i];
    chomp($ln);

    if ( $ln =~ /\#/ ) {
        $satseq[$sorsz] = $satseq[$sorsz].$ln;
        $sorsz++;
    }else{
        $satseq[$sorsz] = $satseq[$sorsz].$ln;
    }
}

$sorsz=0;
foreach $ln (@satseq) {
    $ln =~ s/\s+/ /g;
    $satseq[$sorsz] = $ln;
    # print $sorsz."-".$satseq[$sorsz]."\n";
while ( ($listfaces[$sat_hash{next_face}{$mv}]) ne "\$-1" ) {
            $faces[$nr] = @satseq[&cut($listfaces[$sat_hash{next_face}
+{$mv}])];
            (@listfaces) = split (/ /, $faces[$nr]);
            $nr++;
        }    

        &faceexport;
        # Ki&#65533;r&#65533;ti a @faces t&#65533;mb&#65533;t
        @faces="";
        # Nachdem die face-s schon konvertiert sind wird das
        # komplette body zusammengestellt
        $bodyszam = "B".&number($bodynr).$bodynr;
        print "GBOD ",$bodyszam," NORM",$surfacelist,"\n";
        $bodynr++;
    }       
}

sub faceexport {
    my @coedge;
    my @surfs;
    my @listcoedge;
    my @listloop;
    # Exportiert eine face in eine GSUR
    $felsz = 0;
    foreach $face ( @faces ) { 
        # Sucht die zu einem face geh&#65533;rigen coedge-s zusammen
        @listface = split(/ /, $face);
        $loop = @satseq[&cut($listface[$sat_hash{loop}{$mv}])];
        (@listloop) = split(/ /, $loop);
        $firstcoedge = &cut($listloop[$sat_hash{first_coedge}{$mv}]);
        $coedge[0] = $satseq[&cut($listloop[$sat_hash{first_coedge}{$m
+v}])];
        (@listcoedge) = split(/ /, $coedge[0]);

        $nr=1;
        # Die werden im @coedge gespeichert
        while ( &cut($listcoedge[$sat_hash{next_coedge}{$mv}]) != $fir
+stcoedge ){
            $coedge[$nr] = $satseq[&cut($listcoedge[$sat_hash{next_coe
+dge}{$mv}])];
            (@listcoedge) = split(/ /, $coedge[$nr]);
            $nr++;
        }
        $sorszam = 0;

        # 
        $linelist = "";
        foreach $cedge ( @coedge ) {
            (@listcoedge) = split(/ /, $cedge);
            $edge = $satseq[&cut($listcoedge[$sat_hash{list_coedge}{$m
+v}])];
            (@listedge) = split(/ /, $edge);
    
            # Stellt die richtung einer linie ein
#           print "irany:".$listcoedge[$sat_hash{edge_sign}{$mv}]."\n"
+;
            if ($listcoedge[$sat_hash{edge_sign}{$mv}] eq 'forward') {
                $sign[$sorszam] = " + ";
            } else {
                $sign[$sorszam] = " - ";
            }

            # Sucht die Punkte zusammen
            $vertex1 = $satseq[&cut($listedge[$sat_hash{vert1}{$mv}])]
+;
            $vertex2 = $satseq[&cut($listedge[$sat_hash{vert2}{$mv}])]
+;
            $edgetyp = $satseq[&cut($listedge[$sat_hash{etyp}{$mv}])];
            (@point3) = split(/ /, $edgetyp);

            &points;
            #print "vonalfajta:".$point3[0]."\n";
            if ($point3[0] eq "straight-curve") {
                $vonalsz[$sorszam] = "L".&number($linenr).$linenr;
                $vonalsz[$sorszam] = &linehash(&cut($listcoedge[$sat_h
+ash{list_coedge}{$mv}]),$vonalsz[$sorszam],$vonalp1,$vonalp2);
            } elsif ($point3[0] eq "ellipse-curve") {
                $vonalp3 = "P".&number($pointnr).$pointnr;
                print "PNT ",$vonalp3," ",$point3[$sat_hash{point}{$mv
+}]," ",$point3[($sat_hash{point}{$mv})+1]," ",$point3[($sat_hash{poin
+t}{$mv})+2],"\n";
                $pointnr++;
                $vonalsz[$sorszam] = "L".&number($linenr).$linenr;
                $vonalsz[$sorszam] = &ellipsehash(&cut($listcoedge[$sa
+t_hash{list_coedge}{$mv}]),$vonalsz[$sorszam],$vonalp1,$vonalp2,$vona
+lp3);
            } else {
                $vonalsz[$sorszam] = "L".&number($linenr).$linenr;
                $vonalsz[$sorszam] = &linehash(&cut($listcoedge[$sat_h
+ash{list_coedge}{$mv}]),$vonalsz[$sorszam],$vonalp1,$vonalp2);
            }# if vege
            $linelist = $linelist.$sign[$sorszam].$vonalsz[$sorszam];
            $sorszam++;
        }#foreach $coedge
        # Ki&#65533;r&#65533;ti a @coedge t&#65533;mb&#65533;t
        @coedge="";
        # Besz&#65533;mozza a fel&#65533;letet &#65533;s ki&#65533;rja
+ az &#65533;llom&#65533;nyba
        $surfsz[$felsz] = "S".&number($surfnr).$surfnr;
        $surfacelist = $surfacelist." + ".$surfsz[$felsz];
        print "GSUR ",$surfsz[$felsz]," + BLEND",$linelist,"\n";
        $linelist="";
        $surfnr++;
 $felsz++;

    }#foreach $face
}#faceexport

sub cut {
    # Lev&#65533;gja a $ jelet a seq sorsz&#65533;mr&#65533;l, &#65533
+;s hozz&#65533;ad egyet,
    # mert a geometria le&#65533;r&#65533;sa a harmadik sorban kezd&#6
+5533;d&#65533;tt
    $seq = $_[0];
    $seq =~ s/\$//;    
    $seq = $seq + 3;
    return $seq;
} 

sub number {
    if (length($_[0]) == 1) {
        $p = "00";
    }    
    if (length($_[0]) == 2) {
        $p = "0";
    }    
    if (length($_[0]) == 3) {
        $p = "";
    }    
    return $p;
}

sub pointhash {
    # Pr&#65533;ft ob der Punkt schon exportiert wurde, wenn ja wird i
+hre Nummer f&#65533;r
    # die aktuelle LINE benutzt.
    if ($points[$_[0]]) {
        $retp = $points[$_[0]];
    } else {
        $points[$_[0]]= $_[1];     
        $retp = $_[1];
        print "PNT ",$_[1]," ",$_[2]," ",$_[3]," ",$_[4],"\n";
        $pointnr++
    }
    return $retp;
}    

sub linehash {
    # Pr&#65533;ft ob die Linie schon exportiert wurde, wenn ja wird i
+hre Nummer f&#65533;r
    # die aktuelle GSURF benutzt.
    if ($lines[$_[0]]) {
 $retp = $lines[$_[0]];
    } else {
        $lines[$_[0]]= $_[1];     
        $retp = $_[1];
        print "LINE ",$_[1]," ",$_[2]," ",$_[3]," 102\n";
        $linenr++
    }
    return $retp;
}    

sub ellipsehash {
    # Pr&#65533;ft ob der Bogen schon exportiert wurde, wenn ja wird s
+eine Nummer f&#65533;r
    # die aktuelle GSURF benutzt.
    if ($lines[$_[0]]) {
        $retp = $lines[$_[0]];
    } else {
        $lines[$_[0]]= $_[1];     
        $retp = $_[1];
        print "LINE ",$_[1]," ",$_[2]," ",$_[3]," ",$_[4]," 104\n";
        $linenr++
    }
    return $retp;
}    

sub points {
    # Exportiert die zu eine Linie geh&#65533;rende Punkte (Endpunkte)
+ 
    (@listvert1) = split(/ /, $vertex1);
    (@listvert2) = split(/ /, $vertex2);
    $ppoint1 = $satseq[&cut($listvert1[$sat_hash{listpoint}{$mv}])];
    $ppoint2 = $satseq[&cut($listvert2[$sat_hash{listpoint}{$mv}])];
    (@point1) = split(/ /, $ppoint1);
    (@point2) = split(/ /, $ppoint2);
    $vonalp1 = "P".&number($pointnr).$pointnr;
    $vonalp1 = &pointhash(&cut($listvert1[$sat_hash{vertpoint}{$mv}]),
+$vonalp1,$point1[$sat_hash{point}{$mv}],$point1[($sat_hash{point}{$mv
+})+1],$point1[($sat_hash{point}{$mv})+2]);
    $vonalp2 = "P".&number($pointnr).$pointnr;
    $vonalp2 = &pointhash(&cut($listvert2[$sat_hash{vertpoint}{$mv}]),
+$vonalp2,$point2[$sat_hash{point}{$mv}],$point2[($sat_hash{point}{$mv
+})+1],$point2[($sat_hash{point}{$mv})+2]);
}

sub hashdefine {
    %sat_hash = (
        "lump" => { "4" => "2", "7" => "4", "16" => "5"},
        "shell" => { "4" => "3", "7" => "5", "16" => "6"},
        "first_face" => { "4" => "4", "7" => "6", "16" => "7"},
 "next_face" => { "4" => "2", "7" => "4", "16" => "5"},
        "loop" => { "4" => "3", "7" => "5", "16" => "6"},
        "first_coedge" => { "4" => "3", "7" => "5", "16" => "6"},
        "next_coedge" => { "4" => "2", "7" => "4", "16" => "5"},
        "list_coedge" => { "4" => "5", "7" => "7", "16" => "8"},
        "edge_sign" => { "4" => "6", "7" => "8", "16" => "9"},
        "vert1" => { "4" => "2", "7" => "4", "16" => "5"},
        "vert2" => { "4" => "3", "7" => "6", "16" => "7"},
        "etyp" => { "4" => "5", "7" => "9", "16" => "10"},
        "listpoint" => { "4" => "3", "7" => "5", "16" => "6"},
        "point" => { "4" => "2", "7" => "4", "16" => "5"},
        "vertpoint" => { "4" => "3", "7" => "5", "16" => "6"}
    )
}

sub hashdefine_nr {
    %sat_hash = (
        "lump" => { "4" => "3", "7" => "5", "16" => "6"},
        "shell" => { "4" => "4", "7" => "6", "16" => "7"},
        "first_face" => { "4" => "5", "7" => "7", "16" => "8"},
        "next_face" => { "4" => "3", "7" => "5", "16" => "6"},
        "loop" => { "4" => "4", "7" => "6", "16" => "7"},
        "first_coedge" => { "4" => "4", "7" => "6", "16" => "7"},
        "next_coedge" => { "4" => "3", "7" => "5", "16" => "6"},
        "list_coedge" => { "4" => "6", "7" => "8", "16" => "9"},
        "edge_sign" => { "4" => "7", "7" => "9", "16" => "10"},
        "vert1" => { "4" => "3", "7" => "5", "16" => "6"},
        "vert2" => { "4" => "4", "7" => "7", "16" => "8"},
        "etyp" => { "4" => "6", "7" => "10", "16" => "11"},
        "listpoint" => { "4" => "4", "7" => "6", "16" => "7"},
        "point" => { "4" => "3", "7" => "5", "16" => "6"},
        "vertpoint" => { "4" => "4", "7" => "6", "16" => "7"}
    )
}
[download]

Comment on perl script eats all my PC memory... Download Code

Replies are listed 'Best First'.
Re: perl script eats all my PC memory... by davido (Cardinal) on Feb 19, 2015 at 20:35 UTC
The code doesn't compile, and `use strict;` is commented out (because the code is full of `strict 'vars'` violations). You've also not provided sample input, and haven't mentioned what part of the code is running out of memory. Formatting is sloppy. Those are all things you could fix or do to make it easier for us to provide a useful answer. Dave	[reply] [d/l] [select]
Re: perl script eats all my PC memory... by Old_Gray_Bear (Bishop) on Feb 20, 2015 at 01:00 UTC
I got as far as the third line of your posted code and stopped. `#!/usr/bin/perl # use strict;` [download] You have `strict` commented out. Why....? Never mind, uncomment it. Fix your ~~problems~~ bugs. Try it again. Repeat until it compiles cleanly. Then run it through `perltidy`. Fix your bugs. Iterate until it's clean as can be. Now run it and see if it "eats all you memory. If it does, start debugging your logic. Have fun. ---- I Go Back to Sleep, Now. OGB	[reply] [d/l] [select]
Re: perl script eats all my PC memory... by karlgoethebier (Abbot) on Feb 19, 2015 at 21:17 UTC
Hi AlexAlex, a little addendum to the reply by davido: karls-mac-mini:monks karl$ perl -c 1117265.pl syntax error at 1117265.pl line 63, near "] )" Unmatched right curly bracket at 1117265.pl line 138, at end of line syntax error at 1117265.pl line 138, near "}" Unmatched right curly bracket at 1117265.pl line 139, at end of line syntax error at 1117265.pl line 149, near "}" syntax error at 1117265.pl line 176, near "}" syntax error at 1117265.pl line 192, near "}" syntax error at 1117265.pl line 208, near "}" syntax error at 1117265.pl line 237, near "}" Unmatched right curly bracket at 1117265.pl line 279, at end of line 1117265.pl has too many errors. [download] Please see also perlrun and Perltidy. This nodes might also be helpful: Re: Matching a Word Exactly Re^2: Formatting Perl code with Emacs Re: Concatenating strings with different length Best regards, Karl �The Crux of the Biscuit is the Apostrophe�	[reply] [d/l]
Re: perl script eats all my PC memory... by Ea (Chaplain) on Feb 20, 2015 at 17:41 UTC
From the dates in the file header, this looks like a file you've inherited. Perhaps the first thing to do is write a small script that just contains this `my @satfile = <STDIN>; my @satseq = @satfile;` [download] and see if it runs out of memory. If so, your datafiles are too big to read in and make a copy and you'll want to deal with one line at a time, e.g. `my $sorsz = 3; while (my $line = <STDIN>) { chomp $line; # to remove newlines if ( $. <= 3 ) { # input line numbers start from 1 push @satseq, $line; } elsif ( $line =~ /\#/ ) { $satseq[$sorsz] .= $line; # concatenates line onto the end $sorsz++; } else{ $satseq[$sorsz] .= $line; } }` [download] which is a more memory efficient way to deal with large files. If the concatenation is still killing memory, try `substr($satseq[$sorsz],length($satseq[$sorsz]),0) = $line` Sometimes I can think of 6 impossible LDAP attributes before breakfast.	[reply] [d/l] [select]

Back to Seekers of Perl Wisdom