Re: Out of memory problems

[periapt]

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;