Thread Blöcke aus großen Dateien löschen. (5 answers)
Opened by leo11 at 2009-06-11 17:43

leo11
 2009-06-11 17:43
#122454 #122454
User since
2008-08-14
250 Artikel
BenutzerIn
[default_avatar]
Hallo liebe Perlgemeinde,

unten findet ihr ein Skript, dass folgendes Problem löst:
Gegeben ist eine 150 MB Datei (kann auch durchaus mal > 1GB werden). Darin enthalten sind n Pages. Jede Page beginnt mit einer Zeile an deren Anfang der String PAGE_BEGIN steht. Veranschaulichung des Dateiinhalts:

n Zeilen
PAGE_BEGIN
n Zeilen
PAGE_BEGIN
n Zeilen
PAGE_BEGIN
n Zeilen
...

Alles bis zum ersten PAGE_BEGIN wird nie gelöscht. Die anderen Pages sollen gelöscht werden, sofern in einer ihrer Zeilen der String %%DELETE_PAGE%% steht. D.h. aus
n Zeilen
PAGE_BEGIN
n Zeilen
%%DELETE_PAGE%%
n Zeilen
PAGE_BEGIN
n Zeilen
PAGE_BEGIN
n Zeilen

wird:
n Zeilen
PAGE_BEGIN
n Zeilen
PAGE_BEGIN
n Zeilen

%%DELETE_PAGE%% steht niemals in den Zeilen bis zum ersten Vorkommen von PAGE_BEGIN.

Meine Lösung braucht für eine 150 MB Datei 160 sec.
Wo seht ihr Verbesserungspotential?

Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
use strict;
use warnings;
use Fcntl;
use Tie::File;
use Carp;
use Data::Dumper;
#use Benchmark;

#variables
#-----------------------
my $test_file =$ENV{FILE_NAME};
unless (defined $test_file) {
    croak "No filename in environment (FILENAME)\n";
}

my $path = $ENV{FILE_PATH};
unless (defined $path ) {
    croak "No path directory in environment (FILE_PATH)\n";
}

my $page_begin = '^PAGE_BEGIN$';
my $mark1 = '%%DELETE_PAGE%%';                                                  #delete a complete page
my @tied_metafile;

#MAIN
#-----------------------
#my $anfang = new Benchmark;                                                     #BENCHMARK BEGIN

sysopen METAFILE, $test_file, O_RDWR  or croak "Can't open $test_file: $!";     #open metafile for read/write
tie @tied_metafile, 'Tie::File', \*METAFILE;
my $stored_indexes_ref = search_mark();                                         #do sub 1
delete_marked ( $stored_indexes_ref );                                          #do sub 2
untie @tied_metafile;
close METAFILE or croak "Can't close $test_file: $!";                           #close metafile

#my $ende = new Benchmark;                                                       #BENCHMARK END

#my $vergangen = timediff ($ende, $anfang);                                      #BENCHMARK
#print "Vergangene Zeit: ", timestr ($vergangen), "\n";                          #BENCHMARK

#SUBS
#-----------------------
sub search_mark {
    my $index = 0;
    my @stored_indexes;                                                         #a helping array with relevant indexes
    foreach my $line ( @tied_metafile ) {
        if ( $line =~ m/$page_begin/) {
            unshift( @stored_indexes, $index );
        }
        if ( $line =~ m/$mark1/) {
            my @mark1_match_index;                                              #a helping array with index of mark as first element
            unshift( @mark1_match_index, $index );
            unshift( @stored_indexes, \@mark1_match_index );                    #store reverse
        }
        $index++;
    }
    unshift( @stored_indexes,$#tied_metafile+1);                                #necessary if last page should be deleted
    return \@stored_indexes;
}

sub delete_marked {
    my @stored_indexes_ref = shift;
    my $index = 0;
    print Dumper @stored_indexes_ref;
    foreach ( @$stored_indexes_ref ){
        if ( ref(@$stored_indexes_ref[$index]) eq 'ARRAY') {
            my $del_from = @$stored_indexes_ref[$index+1];
            my $del_until  = @$stored_indexes_ref[$index-1];
            my $range = $del_until - $del_from;
            print "delete from line : ", $del_from, "\n";
            print "delete until line: ", $del_until, "\n";
            print "Range            : ", $range, "\n";
            splice( @tied_metafile, $del_from, $range);                         #delete last lines first
        }
        $index++;
    }
}

exit 0


Bsp.-ausgabe:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
$VAR1 = [
'641002',
134874,
38603,
10731,
1432,
233,
[
199
],
101
];
delete from line : 101
delete until line: 233
Range : 132
Vergangene Zeit: 161 wallclock secs (123.05 usr + 4.64 sys = 127.69 CPU)

View full thread Blöcke aus großen Dateien löschen.