mws/trunk/mbox2index.pl

#!/usr/bin/perl -w

use MWS;
use Data::Dumper;
use Date::Parse;
use POSIX qw(strftime);
use Getopt::Long;

# are we called from this script?
my $recursive = 0;

my $r = GetOptions("recursive" => \$recursive);

my $config_file = shift @ARGV || 'global.conf';

if (! -f $config_file) {
        print qq{Usage: $0 [/path/to/local.conf]

If local.conf is not specified, global.conf in current directory will
be used.
};
        exit 1;
}

my $mws = MWS->new($config_file);

$mws->create_index if (! $recursive);

print STDERR "starting indexing...";

my $debug = 1;

foreach my $mbox ($mws->{config}->Parameters('folders')) {
        my $mbox_path = $mws->{config}->val('folders', $mbox);

        print STDERR "working on $mbox [$mbox_path]\n" if ($debug);

        my $folder = $mws->open_folder($mbox);

        print STDERR $folder->size," bytes\n" if ($debug);

        foreach my $message ($folder->messages) {

                my $id = $message->messageId;

                my $document = {
                        id => $id,
                        folder => $mbox,
                };

                foreach my $direction (qw(to from cc bcc)) {
                        foreach my $part (qw(phrase address comment)) {
                                $document->{$direction.'_'.$part} = join("##", $mws->unroll($message,$direction,$part));
                        }
                }

                $document->{'subject'} = $mws->decode_qp($message->subject) || 'no subject';

                $document->{'body'} = $mws->plain_text_body($message);

                my $utime = str2time($message->date);

                $document->{'date_utime'} = $utime;
                $document->{'date'} = strftime("%Y-%m-%d %H:%M:%S", localtime($utime));

#               print Dumper($document);
                $mws->add_index("$mbox $id" => $document);

                # clear internal MWS cache to keep memory usage down
                # (this should be replaced by garbage collector in MWS,
                # but without it this is the best solution to keep machine
                # alive while indexing)
                $mws->{cache} = {};

                # this is not complete solution. see mailbox-destruct.diff
                $message->destruct();

        }

        $mws->close_folder($mbox);

}

$mws->close_index;
1	#!/usr/bin/perl -w
2
3	use MWS;
4	use Data::Dumper;
5	use Date::Parse;
6	use POSIX qw(strftime);
7	use Getopt::Long;
8
9	# are we called from this script?
10	my $recursive = 0;
11
12	my $r = GetOptions("recursive" => \$recursive);
13
14	my $config_file = shift @ARGV \|\| 'global.conf';
15
16	if (! -f $config_file) {
17	print qq{Usage: $0 [/path/to/local.conf]
18
19	If local.conf is not specified, global.conf in current directory will
20	be used.
21	};
22	exit 1;
23	}
24
25	my $mws = MWS->new($config_file);
26
27	$mws->create_index if (! $recursive);
28
29	print STDERR "starting indexing...";
30
31	my $debug = 1;
32
33	foreach my $mbox ($mws->{config}->Parameters('folders')) {
34	my $mbox_path = $mws->{config}->val('folders', $mbox);
35
36	print STDERR "working on $mbox [$mbox_path]\n" if ($debug);
37
38	my $folder = $mws->open_folder($mbox);
39
40	print STDERR $folder->size," bytes\n" if ($debug);
41
42	foreach my $message ($folder->messages) {
43
44	my $id = $message->messageId;
45
46	my $document = {
47	id => $id,
48	folder => $mbox,
49	};
50
51	foreach my $direction (qw(to from cc bcc)) {
52	foreach my $part (qw(phrase address comment)) {
53	$document->{$direction.'_'.$part} = join("##", $mws->unroll($message,$direction,$part));
54	}
55	}
56
57	$document->{'subject'} = $mws->decode_qp($message->subject) \|\| 'no subject';
58
59	$document->{'body'} = $mws->plain_text_body($message);
60
61	my $utime = str2time($message->date);
62
63	$document->{'date_utime'} = $utime;
64	$document->{'date'} = strftime("%Y-%m-%d %H:%M:%S", localtime($utime));
65
66	# print Dumper($document);
67	$mws->add_index("$mbox $id" => $document);
68
69	# clear internal MWS cache to keep memory usage down
70	# (this should be replaced by garbage collector in MWS,
71	# but without it this is the best solution to keep machine
72	# alive while indexing)
73	$mws->{cache} = {};
74
75	# this is not complete solution. see mailbox-destruct.diff
76	$message->destruct();
77
78	}
79
80	$mws->close_folder($mbox);
81
82	}
83
84	$mws->close_index;