1 | package folder; |
1 | package folder; |
2 | |
2 | |
3 | BEGIN { *slog = \&::slog }; |
3 | BEGIN { *slog = \&::slog }; |
|
|
4 | |
|
|
5 | use Digest::SHA1; |
4 | |
6 | |
5 | use constant MDIFVERSION => 1; |
7 | use constant MDIFVERSION => 1; |
6 | |
8 | |
7 | sub new { |
9 | sub new { |
8 | my $class = shift; |
10 | my $class = shift; |
… | |
… | |
91 | last unless /^([^[].*)=(.*)\n$/; |
93 | last unless /^([^[].*)=(.*)\n$/; |
92 | $self->{host}{$1} = $2; |
94 | $self->{host}{$1} = $2; |
93 | } |
95 | } |
94 | } elsif (/^\[DIFF (\d+)\]\n$/) { |
96 | } elsif (/^\[DIFF (\d+)\]\n$/) { |
95 | my $mtime = $1; |
97 | my $mtime = $1; |
96 | my @dif; |
98 | my (@add, @del); |
97 | while (<$fh>) { |
99 | while (<$fh>) { |
98 | last unless /^[+-]/; |
100 | last unless /^([+-])(.*)\n$/; |
99 | push @dif, substr $_, 0, -1; |
101 | if ($1 eq "+") { |
|
|
102 | push @add, $2; |
|
|
103 | } else { |
|
|
104 | push @del, $2; |
100 | } |
105 | } |
|
|
106 | } |
101 | unshift @{$self->{diff}}, [$mtime, \@dif]; |
107 | unshift @{$self->{diff}}, [$mtime, \@add, \@del]; |
102 | } elsif ($_ eq "[INDEX]\n") { |
108 | } elsif ($_ eq "[INDEX]\n") { |
103 | my @idx; |
109 | my @idx; |
104 | while (<$fh>) { |
110 | while (<$fh>) { |
105 | last unless /^(\d+)=(.*)\n$/; |
111 | last unless /^(\d+)=(.*)\n$/; |
106 | push @idx, [$1, $2]; |
112 | push @idx, [$1, $2]; |
… | |
… | |
140 | print $fh "[INDEX]\n"; |
146 | print $fh "[INDEX]\n"; |
141 | print $fh "$_->[0]=$_->[1]\n" for @{$self->{idx}}; |
147 | print $fh "$_->[0]=$_->[1]\n" for @{$self->{idx}}; |
142 | |
148 | |
143 | for (reverse @{$self->{diff}}) { |
149 | for (reverse @{$self->{diff}}) { |
144 | print $fh "[DIFF $_->[0]]\n"; |
150 | print $fh "[DIFF $_->[0]]\n"; |
145 | print $fh $_, "\n" for @{$_->[1]}; |
151 | print $fh "+$_\n" for @{$_->[1]}; |
|
|
152 | print $fh "-$_\n" for @{$_->[2]}; |
146 | } |
153 | } |
147 | |
154 | |
148 | close $fh |
155 | close $fh |
149 | or die "$path~: unable to create updated .mdif: $!"; |
156 | or die "$path~: unable to create updated .mdif: $!"; |
150 | |
157 | |
151 | rename "$path~", $path; |
158 | rename "$path~", $path; |
152 | |
159 | |
153 | delete $self->{dirty}; |
160 | delete $self->{dirty}; |
154 | } |
161 | } |
155 | |
162 | |
|
|
163 | if (1) { |
|
|
164 | use OpenSSL (); |
|
|
165 | *hash = \&OpenSSL::Digest::sha1_hex; |
|
|
166 | } elsif (0) { |
|
|
167 | # use Digest::SHA1; |
|
|
168 | my $digest = new Digest::SHA1; |
|
|
169 | *hash = sub { |
|
|
170 | $digest->reset; |
|
|
171 | $digest->add(@_); |
|
|
172 | $mid = $digest->hexdigest; |
|
|
173 | }; |
|
|
174 | } |
|
|
175 | |
156 | sub gendiff { |
176 | sub gendiff { |
157 | my ($d1, $d2) = @_; |
177 | my ($d1, $d2) = @_; |
158 | |
178 | |
159 | my @d; |
179 | my (@add, @del); |
160 | my (%d1, %d2); |
180 | my (%d1, %d2); |
161 | |
181 | |
162 | for (@$d2) { |
182 | for (@$d2) { |
163 | undef $d2{$_->[1]}; |
183 | undef $d2{$_->[1]}; |
164 | } |
184 | } |
165 | |
185 | |
166 | # delete msgs in d1 but not in d2 |
186 | # delete msgs in d1 but not in d2 |
167 | for (@$d1) { |
187 | for (@$d1) { |
168 | undef $d1{$_->[1]}; |
188 | undef $d1{$_->[1]}; |
169 | push @d, "-$_->[1]" unless exists $d2{$_->[1]}; |
189 | push @del, $_->[1] unless exists $d2{$_->[1]}; |
170 | } |
190 | } |
171 | %d2 = (); # conserve memory |
191 | %d2 = (); # conserve memory |
172 | |
192 | |
173 | # add msgs in d2 but not in d1 |
193 | # add msgs in d2 but not in d1 |
174 | for (@$d2) { |
194 | for (@$d2) { |
175 | push @d, "+$_->[1]" unless exists $d1{$_->[1]}; |
195 | push @add, $_->[1] unless exists $d1{$_->[1]}; |
176 | } |
196 | } |
177 | |
197 | |
178 | \@d; |
198 | (\@add, \@del); |
179 | } |
199 | } |
180 | |
200 | |
181 | sub check { |
201 | sub check { |
182 | my $self = shift; |
202 | my $self = shift; |
183 | my $path = $self->{path}; |
203 | my $path = $self->{path}; |
… | |
… | |
208 | |
228 | |
209 | my @idx; |
229 | my @idx; |
210 | |
230 | |
211 | parse_mbox $path, sub { |
231 | parse_mbox $path, sub { |
212 | my ($offs, $head, $body) = @_; |
232 | my ($offs, $head, $body) = @_; |
213 | my $mid; |
233 | push @idx, [$offs, hash($$head, "\0", $$body)]; |
214 | if ($$head =~ /^Message-Id:\s*(<[^<\n]+>)\s*\n/im) { |
|
|
215 | $mid = $1; |
|
|
216 | } else { |
|
|
217 | $mid = MD5->hexhash("$$head\0$$body"); |
|
|
218 | } |
|
|
219 | push @idx, [$offs, $mid]; |
|
|
220 | } or return (); |
234 | } or return (); |
221 | |
235 | |
222 | $self->read_mdif; |
236 | $self->read_mdif; |
223 | |
237 | |
224 | if ($self->{version}) { |
|
|
225 | my $d = gendiff $self->{idx}, \@idx; |
|
|
226 | push @{$self->{diff}}, [ |
|
|
227 | $self->{mtime}, |
|
|
228 | $d, |
|
|
229 | ] if @$d; |
|
|
230 | } else { |
|
|
231 | slog 2, "$path: previously unknown folder\n"; |
|
|
232 | $self->{version} ||= MDIFVERSION; |
238 | $self->{version} ||= MDIFVERSION; |
233 | } |
239 | my ($add, $del) = gendiff $self->{idx}, \@idx; |
|
|
240 | push @{$self->{diff}}, [ |
|
|
241 | $mtime, |
|
|
242 | $add, $del, |
|
|
243 | ] if @$add || @$del; |
234 | |
244 | |
235 | $self->{fsize} = $fsize; |
245 | $self->{fsize} = $fsize; |
236 | $self->{mtime} = $mtime; |
246 | $self->{mtime} = $mtime; |
237 | $self->{idx} = \@idx; |
247 | $self->{idx} = \@idx; |
238 | |
248 | |