mws/trunk/MWS.pm

#!/usr/bin/perl -w

package MWS;

use strict;
use warnings;
use Carp;

use Plucene::Simple;
use Mail::Box::Manager;
use Config::IniFiles;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ();
our @EXPORT_OK;
our @EXPORT;

our $VERSION = '1.00';


my $folder;     # placeholder for folders

my $debug = 1;

sub new {
        my $class = shift;
        my $self = {};
        bless($self, $class);

        my $config_file = shift || die "need index file";

        $self->{config} = new Config::IniFiles( -file => $config_file );

        my $index_file = $self->{config}->val('global', 'index') || croak "can't find [index] section in config file with path of index";

        $self->{index} = Plucene::Simple->open($index_file) || croak "can't open index '$index_file': $!";

        $self->{mgr} = Mail::Box::Manager->new;

        # placeholder for opened folders
        $self->{folder} = {};

        return $self;
}

sub open_folder {
        my $self = shift;

        my $mbox = shift || croak "open_folder needs mbox name";

        if (! $self->{folder}->{$mbox}) {
                my $mbox_path = $self->{config}->val('folders', $mbox) || croak "comeone removed folder $mbox from config?";
                $self->{folder}->{$mbox} = $self->{mgr}->open($mbox_path) || croak "can't open folder $mbox at '$mbox_path': $!";
                print STDERR "## open($mbox)\n" if ($debug);
        }

        return $self->{folder}->{$mbox};

}

sub fetch_message {
        my $self = shift;

        my $mbox_id = shift || die "need mbox_id!";
        my ($mbox,$id) = split(/ /,$mbox_id);

        # return message with ID
        return $self->open_folder($mbox)->find($id) ||
                print STDERR "can't find message $id in $mbox. Time to re-index?\n";
}


sub search {
        my $self = shift;

        my $s = shift || carp "search called without argument!";

        my @index_ids = $self->{index}->search($s);

        $self->{'index_ids'} = \@index_ids;

        my $results = $#index_ids + 1;
        $self->{'results'} = $results;

        $self->{'curr_result'} = 0;

        return $results || 'error';
}

sub unroll($$$) {
        my ($message,$part,$sub) = @_;

        my @arr;

        foreach my $from ($message->$part) {
                my $tmp = $from->$sub;
                $tmp =~ s/^\s*["'](.*)["']\s*$/$1/;
                push @arr, $tmp;
        }
        return \@arr;
}

sub fetch_all_results {
        my $self = shift;

        croak "results called before search!" if (! $self->{'index_ids'});

        my @arr;

        foreach my $id (@{$self->{'index_ids'}}) {
                push @arr, $self->fetch_result_by_id($id);
        }

        return @arr;
}

sub fetch_result {
        my $self = shift;

        my $args = {@_};

        croak "results called before search!" if (! $self->{'index_ids'});

        my $curr = $self->{'curr_result'}++;

        my $id = $self->{'index_ids'}->[$curr];

        return $self->fetch_result_by_id($id);
}

sub plain_text_body {
        my $self = shift;
        my $message = shift || croak "plain_text_body needs message!";

        if (! $message->isMultipart) {
                return $message->decoded->string;
        } else {
                foreach my $part ($message->parts) {
                        if ($part->body->mimeType eq 'text/plain') {
                                return $part->decoded->string;
                        }
                }
        }
}


sub fetch_result_by_id {
        my $self = shift;

        my $id = shift || return;

        my $message = $self->fetch_message($id);

        my $row;

        $row->{'id'} = $id;
        $row->{'from'} = unroll($message,'from','phrase');
        $row->{'subject'} = $message->subject;
        $row->{'body'} = $self->plain_text_body($message);

        return $row;
        
}
1	dpavlin	2	#!/usr/bin/perl -w
2
3			package MWS;
4
5			use strict;
6			use warnings;
7			use Carp;
8
9	dpavlin	3	use Plucene::Simple;
10			use Mail::Box::Manager;
11	dpavlin	4	use Config::IniFiles;
12	dpavlin	3
13	dpavlin	2	require Exporter;
14
15			our @ISA = qw(Exporter);
16
17			our %EXPORT_TAGS = ();
18			our @EXPORT_OK;
19			our @EXPORT;
20
21			our $VERSION = '1.00';
22
23
24			my $folder; # placeholder for folders
25
26			my $debug = 1;
27
28			sub new {
29			my $class = shift;
30			my $self = {};
31			bless($self, $class);
32
33	dpavlin	4	my $config_file = shift \|\| die "need index file";
34	dpavlin	2
35	dpavlin	4	$self->{config} = new Config::IniFiles( -file => $config_file );
36	dpavlin	2
37	dpavlin	4	my $index_file = $self->{config}->val('global', 'index') \|\| croak "can't find [index] section in config file with path of index";
38
39			$self->{index} = Plucene::Simple->open($index_file) \|\| croak "can't open index '$index_file': $!";
40
41	dpavlin	2	$self->{mgr} = Mail::Box::Manager->new;
42
43			# placeholder for opened folders
44			$self->{folder} = {};
45
46			return $self;
47			}
48
49	dpavlin	7	sub open_folder {
50	dpavlin	2	my $self = shift;
51
52	dpavlin	7	my $mbox = shift \|\| croak "open_folder needs mbox name";
53	dpavlin	2
54			if (! $self->{folder}->{$mbox}) {
55	dpavlin	4	my $mbox_path = $self->{config}->val('folders', $mbox) \|\| croak "comeone removed folder $mbox from config?";
56			$self->{folder}->{$mbox} = $self->{mgr}->open($mbox_path) \|\| croak "can't open folder $mbox at '$mbox_path': $!";
57	dpavlin	2	print STDERR "## open($mbox)\n" if ($debug);
58			}
59
60	dpavlin	7	return $self->{folder}->{$mbox};
61
62			}
63
64			sub fetch_message {
65			my $self = shift;
66
67			my $mbox_id = shift \|\| die "need mbox_id!";
68			my ($mbox,$id) = split(/ /,$mbox_id);
69
70			# return message with ID
71			return $self->open_folder($mbox)->find($id) \|\|
72	dpavlin	2	print STDERR "can't find message $id in $mbox. Time to re-index?\n";
73			}
74
75
76			sub search {
77			my $self = shift;
78
79			my $s = shift \|\| carp "search called without argument!";
80
81			my @index_ids = $self->{index}->search($s);
82
83			$self->{'index_ids'} = \@index_ids;
84
85			my $results = $#index_ids + 1;
86			$self->{'results'} = $results;
87
88			$self->{'curr_result'} = 0;
89
90			return $results \|\| 'error';
91			}
92
93			sub unroll($$$) {
94			my ($message,$part,$sub) = @_;
95
96			my @arr;
97
98			foreach my $from ($message->$part) {
99	dpavlin	7	my $tmp = $from->$sub;
100			$tmp =~ s/^\s["'](.)["']\s*$/$1/;
101			push @arr, $tmp;
102	dpavlin	2	}
103			return \@arr;
104			}
105	dpavlin	4
106			sub fetch_all_results {
107			my $self = shift;
108
109			croak "results called before search!" if (! $self->{'index_ids'});
110
111			my @arr;
112
113			foreach my $id (@{$self->{'index_ids'}}) {
114			push @arr, $self->fetch_result_by_id($id);
115			}
116
117			return @arr;
118			}
119
120	dpavlin	2	sub fetch_result {
121			my $self = shift;
122
123	dpavlin	3	my $args = {@_};
124
125	dpavlin	2	croak "results called before search!" if (! $self->{'index_ids'});
126
127			my $curr = $self->{'curr_result'}++;
128
129			my $id = $self->{'index_ids'}->[$curr];
130
131	dpavlin	4	return $self->fetch_result_by_id($id);
132			}
133	dpavlin	2
134	dpavlin	7	sub plain_text_body {
135			my $self = shift;
136			my $message = shift \|\| croak "plain_text_body needs message!";
137
138			if (! $message->isMultipart) {
139			return $message->decoded->string;
140			} else {
141			foreach my $part ($message->parts) {
142			if ($part->body->mimeType eq 'text/plain') {
143			return $part->decoded->string;
144			}
145			}
146			}
147			}
148
149
150	dpavlin	4	sub fetch_result_by_id {
151			my $self = shift;
152
153			my $id = shift \|\| return;
154
155	dpavlin	2	my $message = $self->fetch_message($id);
156
157			my $row;
158
159	dpavlin	7	$row->{'id'} = $id;
160	dpavlin	2	$row->{'from'} = unroll($message,'from','phrase');
161	dpavlin	7	$row->{'subject'} = $message->subject;
162			$row->{'body'} = $self->plain_text_body($message);
163	dpavlin	2
164			return $row;
165
166			}