--- trunk/MWS.pm 2004/05/06 19:46:58 14 +++ trunk/MWS.pm 2004/05/07 20:52:34 19 @@ -10,6 +10,8 @@ use Config::IniFiles; use POSIX qw(strftime); use Text::Autoformat; +use Text::Iconv; +use Text::Unaccent; #use MWS_plucene; use MWS_swish; @@ -46,10 +48,56 @@ $self->{folder} = {}; $self->{wrap_margin} = $self->{config}->val('global', 'wrap_margin'); + $self->{max_results} = $self->{config}->val('global', 'max_results') || 100; + $self->reset_counters; return $self; } +sub normalize_string { + my $self = shift; + + my $v = shift || return; + + $v = unac_string('ISO-8859-2', $v); + $v = join('',sort split(/\s+/,$v)); + $v =~ s/\W+//g; + + return $v; +} + +# reset tables for search results +sub reset_counters { + my $self = shift; + + $self->{counter} = {}; + +# foreach my $c (qw(thread from to cc bcc lists links att)) { +# $self->{counter}->{$c} = {}; +# } + +} + +sub add_counter($$) { + my $self = shift; + + my ($c,$v) = @_; + my $k = $self->normalize_string($v); + + $self->{counter}->{$c}->{$k}->{name} = $v; + return $self->{counter}->{$c}->{$k}->{usage}++; +} + +sub counter { + my $self = shift; + + my $c = shift || return; + + return if (! $self->{counter}->{$c}); + + return $self->{counter}->{$c}; +} + sub mbox_name2path { my $self = shift; @@ -73,6 +121,8 @@ print STDERR "open_folder($mbox) ok\n" if ($debug); } + $self->{fetch_count} = 0; + return $self->{folder}->{$mbox}; } @@ -82,7 +132,11 @@ my $mbox = shift || croak "open_folder needs mbox name"; - return $self->{folder}->{$mbox}->close(write => 'NEVER'); + $self->{folder}->{$mbox}->close(write => 'NEVER') || croak "can't close folder $mbox"; + + # XXX this is rather agressive!!! + $self->{folder} = {}; + return } sub fetch_message { @@ -93,8 +147,19 @@ # return message with ID print STDERR "fetch $id from $mbox\n" if ($debug); - return $self->open_folder($mbox)->find($id) || + + if ($self->{fetch_count}++ > 100) { + $self->close_folder($mbox); + print STDERR "close_folder($mbox) forced on ",$self->{fetch_count},"iteration\n"; + } + + my $msg = $self->open_folder($mbox)->find($id); + if ($msg) { + return $msg; + } else { print STDERR "can't find message $id in $mbox. Time to re-index?\n"; + return; + } } @@ -103,13 +168,17 @@ my $s = shift || carp "search called without argument!"; + $self->reset_counters; + print STDERR "search_index($s)\n" if ($debug == 2); my @index_ids = $self->search_index($s); $self->{'index_ids'} = \@index_ids; - my $results = $#index_ids + 1; - $self->{'results'} = $results; + #my $results = $#index_ids + 1; + #$self->{'results'} = $results; + + my $results = $self->{'total_hits'} || ($#index_ids + 1); $self->{'curr_result'} = 0; @@ -118,6 +187,26 @@ return $results || 'error'; } +sub decode_qp($) { + my $self = shift; + + my $tmp = shift || return; + + sub decode($$) { + my ($cp,$qp) = @_; + my $iconv = Text::Iconv->new($cp,'ISO-8859-2'); + print STDERR "decode($cp,$qp) -> " if ($debug == 2); + $qp =~ s/=([a-f0-9][a-f0-9])/chr(hex($1))/ieg; + $qp =~ s/_/ /g; + print STDERR "$qp\n" if ($debug == 2); + return $iconv->convert($qp) || $qp; + } + + $tmp =~ s/=\?([^\?]+)\?Q\?(.+?)\?=/decode($1,$2)/ex; + $tmp =~ s/^\s*["']+(.*?)["']+\s*$/$1/g; + return $tmp; +} + sub unroll($$$) { my $self = shift; @@ -125,12 +214,13 @@ my @arr; + return if (! $message->$part); + foreach my $from ($message->$part) { - my $tmp = $from->$sub; - if ($tmp) { - $tmp =~ s/^\s*["'](.*)["']\s*$/$1/; - push @arr, $tmp; - } + my $tmp = $from->$sub || next; + + $tmp = $self->decode_qp($tmp); + push @arr, $tmp; } return @arr; @@ -149,6 +239,7 @@ push @arr, $self->fetch_result_by_id($id); } + return @arr; } @@ -188,7 +279,8 @@ # reformat with Text::Autoformat my $wrap = $self->{wrap_margin}; if ($wrap && $body && $body =~ m/^.{$wrap}..*$/m) { - $body = autoformat $body; + $body =~ s/[\r\n]/\n/gs; + $body = autoformat($body, {right=>$wrap}); $body .="\n[reformated using autoformat, margin at $wrap]" if ($debug == 2); } @@ -207,13 +299,17 @@ print STDERR "fetch_result_by_id($id) not in cache, hitting disk\n" if ($debug == 2); - my $message = $self->fetch_message($id) || print STDERR "can't fetch message '$id'"; + my $message = $self->fetch_message($id) || return; $row->{'id'} = $id; - @{$row->{'from'}} = $self->unroll($message,'from','phrase'); - @{$row->{'to'}} = $self->unroll($message,'to','phrase'); - @{$row->{'cc'}} = $self->unroll($message,'cc','phrase'); - $row->{'subject'} = $message->subject; + + foreach my $p (qw(from to cc bcc)) { + foreach my $v ($self->unroll($message,'from','phrase')) { + push @{$row->{$p}},$v; + $self->add_counter($p,$v); + } + } + $row->{'subject'} = $self->decode_qp($message->subject); $row->{'body'} = $self->plain_text_body($message); $row->{'date'} = $message->date;