Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Re: Out of memory problems

by periapt (Hermit)
on Oct 27, 2004 at 14:13 UTC ( [id://403014]=note: print w/replies, xml ) Need Help??


in reply to Out of memory problems

BrowserUk wasn't kidding. This is not a simple problem. How about something like below. This way, rather than reduce your original data block to what you need, you build the output block from what you need block by block. I didn't test all of the edge conditions but it worked on the main ones. Let me know if this helps.

$/ = \384; # 2K blocks my $blocksz = 384; my $final = ''; my $block = ''; my $lastfound = 0; my $blocklen = 0; open IN, "perlmonks66_tmp.txt"; open OUT, ">>pm66out.txt"; #more efficient when parsing more tha +n one block #Extract the necessary data bits my $block01 = <IN>; my $block02 = ''; while ($block02 = <IN>) { # if pattern matches my $tmphold = ''; do{ $block = $block01.$block02; $block02 = ''; pos($block) = 0; # position pointer at begin +ning $blocklen = length($block); $block =~ m/\G # pick up where you left of +f (.*) # match zero or more chars +up to ... 11110100 # match byte marker (0x06D4 +) ( 1 byte) .{8} # match any seq of 8 chars + ( 1 byte) (.{1520}) # capture the next 1520 cha +rs (190 bytes) 11110100 # match byte marker (0x06D4 +) ( 1 byte) .{8} # match any seq of 8 chars + ( 1 byte) (.{464}) # capture next 464 chars + ( 58 bytes) .{1056} # matching any seq of 1056 +chars (132 bytes) /xg ; if(defined(pos($block))){ my ($tmp1,$tmp2,$tmp3) = ($1,$2,$3); # match found ==> use parts $tmphold .= join('',map { $_ ||= '' } ($tmp1,$tmp2,$tm +p3)); $block01 = substr($block,-($blocklen-$blocksz)); }else{ if(length($block) >= 2*$blocksz){ $tmphold .= substring($block,0,$blocksz); $block01 = substr($block,-($blocklen-$blocksz)); }else{ $block01 = $block; $block = ''; } } }while(length($block) >= $blocksz); # save the remaining unmatched/unchecked char +s $final = $tmphold; print OUT "$final"; $final = ''; # this is strictly unnecssary but does keep varia +ble clean } $final = pack("B*", $block01); # get final block print OUT "$final"; close OUT; close IN; exit;

PJ
use strict; use warnings; use diagnostics;

Replies are listed 'Best First'.
Re^2: Out of memory problems
by tperdue (Sexton) on Oct 27, 2004 at 15:08 UTC
    Thanks to BrowserUK I was able to get the following code to work for byte aligned data, however I've ran into a situation where some of the data isn't byte aligned meaning the patterns I'm looking for go across byte boundaries. I'll have to do this at a bit level. Any idea how to tweak the code to do this?? #! perl -sw use strict; use bytes; open IN, '< :raw', $ARGV 0 or die "$ARGV 0 : $!"; open OUT, '> :raw', $ARGV 1 or die "$ARGV 1 : $!"; ## Grab a double buffer load first time so we can check & correct alig +nment local $/ = \768; my $buf = <IN>; ## Read two frames worth ## Check alignment. Assumes the xf4 .191 xf4 is unique per frame? $buf =~ m(\xF4.{191}\xF4); ## Record the offset to the first frame my $offset = $-[0]; ## If there was an offset to the first match if( $offset != 0 ) { ## Chop off the leading junk substr( $buf, 0, $offset, '' ); ## Top up the buffer to two full frames read( IN, $buf, $offset, 768 - $offset ); warn "$offset bytes discarded from front of file."; } ## Process the first two whole frames print OUT unpack 'x2 a190 x2 a58 x132' x 2, $buf ## Now process as before local $/ = \384; ## Read file in 384 byte chunks. while( <IN> ) { print OUT unpack 'x2 a190 x2 a58', $_; } close IN; close OUT;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://403014]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (4)
As of 2024-04-25 12:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found