Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

perl script eats all my PC memory...

by AlexAlex (Initiate)
on Feb 19, 2015 at 20:24 UTC ( #1117265=perlquestion: print w/replies, xml ) Need Help??

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

Hi

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"} ) }

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

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;
    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

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.

    Please see also perlrun and Perltidy.

    This nodes might also be helpful:

    Best regards, Karl

    «The Crux of the Biscuit is the Apostrophe»

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;
    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; } }
    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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1117265]
Approved by GrandFather
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (8)
As of 2021-04-14 14:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?