/[mws]/trunk/MWS.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/MWS.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4 - (hide annotations)
Tue May 4 15:47:14 2004 UTC (20 years ago) by dpavlin
File size: 2867 byte(s)
added CGI interface (slow), global configuration, templates

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    
50     sub fetch_message {
51     my $self = shift;
52    
53     my $mbox_id = shift || die "need mbox_id!";
54     my ($mbox,$id) = split(/ /,$mbox_id);
55    
56     if (! $self->{folder}->{$mbox}) {
57 dpavlin 4 my $mbox_path = $self->{config}->val('folders', $mbox) || croak "comeone removed folder $mbox from config?";
58     $self->{folder}->{$mbox} = $self->{mgr}->open($mbox_path) || croak "can't open folder $mbox at '$mbox_path': $!";
59 dpavlin 2 print STDERR "## open($mbox)\n" if ($debug);
60     }
61    
62     my $message = $self->{folder}->{$mbox}->find($id) ||
63     print STDERR "can't find message $id in $mbox. Time to re-index?\n";
64    
65     return $message;
66     }
67    
68    
69     sub search {
70     my $self = shift;
71    
72     my $s = shift || carp "search called without argument!";
73    
74     my @index_ids = $self->{index}->search($s);
75    
76     $self->{'index_ids'} = \@index_ids;
77    
78     my $results = $#index_ids + 1;
79     $self->{'results'} = $results;
80    
81     $self->{'curr_result'} = 0;
82    
83     return $results || 'error';
84     }
85    
86     sub unroll($$$) {
87     my ($message,$part,$sub) = @_;
88    
89     my @arr;
90    
91     foreach my $from ($message->$part) {
92     push @arr, $from->$sub;
93     }
94     return \@arr;
95     }
96 dpavlin 4
97     sub fetch_all_results {
98     my $self = shift;
99    
100     croak "results called before search!" if (! $self->{'index_ids'});
101    
102     my @arr;
103    
104     foreach my $id (@{$self->{'index_ids'}}) {
105     push @arr, $self->fetch_result_by_id($id);
106     }
107    
108     return @arr;
109     }
110    
111 dpavlin 2 sub fetch_result {
112     my $self = shift;
113    
114 dpavlin 3 my $args = {@_};
115    
116 dpavlin 2 croak "results called before search!" if (! $self->{'index_ids'});
117    
118     my $curr = $self->{'curr_result'}++;
119    
120     my $id = $self->{'index_ids'}->[$curr];
121    
122 dpavlin 4 return $self->fetch_result_by_id($id);
123     }
124 dpavlin 2
125 dpavlin 4 sub fetch_result_by_id {
126     my $self = shift;
127    
128     my $id = shift || return;
129    
130 dpavlin 2 my $message = $self->fetch_message($id);
131    
132     my $row;
133    
134     $row->{'from'} = unroll($message,'from','phrase');
135     $row->{'subject'} = $message->get('Subject');
136 dpavlin 3 if (! $message->isMultipart) {
137     $row->{'body'} = $message->decoded->string;
138     } else {
139     foreach my $part ($message->parts) {
140     if ($part->body->mimeType eq 'text/plain') {
141     $row->{'body'} = $part->decoded->string;
142     last;
143     }
144     }
145     }
146 dpavlin 2
147     return $row;
148    
149     }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26