swish-e/prog-bin/index_hypermail.pl

#!/usr/local/bin/perl -w
use strict;

=pod

    This is an example program for use with swish-e's -S prog indexing method.

    This will scan and index a hypermail (http://hypermail.org) mailing list archive.

    You might use a config file such as:

        IndexDir ./index_hypermail.pl
        SwishProgParameters /usr/local/hypermail/foo

        MetaNames swishtitle name email
        PropertyNames name email
        PropertyNamesDate sent
        IndexContents HTML2 .html
        StoreDescription HTML2 <body> 100000
        UndefinedMetaTags  ignore

    The above expects this file (index_hypermail.pl) to be in the current diretory,
    and expects the hypermail files to be in the directory /usr/local/hypermail/foo.

    Index with the command:

        ./swish-e -c swish.conf -S prog

    See perldoc examples/swish.cgi for how to search this index.  Here's a possible
    config file for use with swish.cgi:

    >cat .swishcgi.conf

    return {
        title           => "Search the Foo List Archive",
        swish_binary    => '../swish-e',
        display_props   => [qw/ name email sent /],
        sorts           => [qw/swishrank swishtitle email sent/],
        secondary_sort  => [qw/sent desc/],  
        metanames       => [qw/swishdefault swishtitle name email/],
        name_labels     => {
            swishrank   =>  'Rank',
            swishtitle  =>  'Subject Only',
            name        =>  "Poster's Name",
            email       =>  "Poster's Email",
            sent        =>  'Message Date',
            swishdefault  =>  'Subject & Body',
        },

        highlight       => {
            package         => 'PhraseHighlight',
            show_words      => 10,    # Number of swish words words to show around highlighted word
            max_words       => 100,   # If no words are found to highlighted then show this many words
            occurrences     => 6,     # Limit number of occurrences of highlighted words
            highlight_on    => '<font style="background:#FFFF99">',
            highlight_off   => '</font>',
            meta_to_prop_map => {   # this maps search metatags to display properties
                swishdefault    => [ qw/swishtitle swishdescription/ ],
                swishtitle      => [ qw/swishtitle/ ],
                email           => [ qw/email/ ],
                name            => [ qw/name/ ], 
                swishdocpath    => [ qw/swishdocpath/ ],
            },
        },
        date_ranges     => {
            property_name   => 'sent',      # property name to limit by
            time_periods    => [  
                'All',
                'Today',
                'Yesterday',
                'This Week',
                'Last Week',
                'Last 90 Days',
                'This Month',
                'Last Month',
            ],

            line_break      => 0,
            default         => 'All',
            date_range      => 1,
        },
    };


=cut


use File::Find;  # for recursing a directory tree
use Date::Parse;
    
# Recurse the directory(s) passed in on the command line

find( { wanted   => \&wanted, no_chdir => 1, }, @ARGV );


sub wanted {
    return if -d;
    return  unless m!(^|/)\d+\.html$!;

    my $mtime = (stat $File::Find::name )[9];

    my $html = format_message($File::Find::name );
    return unless $html;

    my $size = length $html;

    my $name = $File::Find::name;
    $name =~ s[^./][];

    print <<EOF;
Content-Length: $size
Last-Mtime: $mtime
Path-Name: $name

EOF

    print $html;
}
    
    
sub format_message {
    my $file = shift;
    local $_;

    unless ( open FH, "<$file" ) {
        warn "Failed to open '$file'. Error: $!";
        return;
    }

    my %fields;

    while (<FH>) {
        if ( my( $tag, $content) = /<!-- ([^=]+)="(.+)" -->$/ ) {
            last if $tag eq 'body';

            unless ( $content ) {
                warn "File '$file' tag '$tag' empty content\n";
                next;
            }

            if ( $tag eq 'sent' ) {
                my $date = str2time $content;
                unless ( defined $date ) {
                    warn "File '$file' tag '$tag' failed to parse '$content'\n";
                    next;
                }
                $content = $date;
            }

            if ( $tag eq 'received' ) {
                my $date = str2time $content;
                unless ( defined $date ) {
                    warn "File '$file' tag '$tag' failed to parse '$content'\n";
                    next;
                }
                $content = $date;
            }
                   
            
            if ( $tag eq 'subject' ) {
                $content =~ s/\Q[SWISH-E]\E//;
                if ( $content =~ s/\s*Re:\s*//i ) {
                   $content .= ' (Re)';
                }
            }

            $fields{$tag} = $content;
        }
    }

    # Let's now use received header, if possible
    $fields{sent} = $fields{received} || $fields{sent};

    my $body = '';

    while ( <FH> ) {
        last if /<!-- body="end" -->/ || /^-- $/ || /^--$/ || /^(_|-){40,}\s*$/;

        $body .= $_;
    }

    return  join "\n",
            '<html>',
            '<head>',
            '<title>',
            ($fields{subject} || '' ),
            '</title>',
            map( { qq[<meta name="$_" content="$fields{$_}">] } keys %fields ),
            '</head><body>',
            $body,
            '</body>',
            '</html>',
            '';
}            

1	adcroft	1.1	#!/usr/local/bin/perl -w
2			use strict;
3
4			=pod
5
6			This is an example program for use with swish-e's -S prog indexing method.
7
8			This will scan and index a hypermail (http://hypermail.org) mailing list archive.
9
10			You might use a config file such as:
11
12			IndexDir ./index_hypermail.pl
13			SwishProgParameters /usr/local/hypermail/foo
14
15			MetaNames swishtitle name email
16			PropertyNames name email
17			PropertyNamesDate sent
18			IndexContents HTML2 .html
19			StoreDescription HTML2 <body> 100000
20			UndefinedMetaTags ignore
21
22			The above expects this file (index_hypermail.pl) to be in the current diretory,
23			and expects the hypermail files to be in the directory /usr/local/hypermail/foo.
24
25			Index with the command:
26
27			./swish-e -c swish.conf -S prog
28
29			See perldoc examples/swish.cgi for how to search this index. Here's a possible
30			config file for use with swish.cgi:
31
32			>cat .swishcgi.conf
33
34			return {
35			title => "Search the Foo List Archive",
36			swish_binary => '../swish-e',
37			display_props => [qw/ name email sent /],
38			sorts => [qw/swishrank swishtitle email sent/],
39			secondary_sort => [qw/sent desc/],
40			metanames => [qw/swishdefault swishtitle name email/],
41			name_labels => {
42			swishrank => 'Rank',
43			swishtitle => 'Subject Only',
44			name => "Poster's Name",
45			email => "Poster's Email",
46			sent => 'Message Date',
47			swishdefault => 'Subject & Body',
48			},
49
50			highlight => {
51			package => 'PhraseHighlight',
52			show_words => 10, # Number of swish words words to show around highlighted word
53			max_words => 100, # If no words are found to highlighted then show this many words
54			occurrences => 6, # Limit number of occurrences of highlighted words
55			highlight_on => '<font style="background:#FFFF99">',
56			highlight_off => '</font>',
57			meta_to_prop_map => { # this maps search metatags to display properties
58			swishdefault => [ qw/swishtitle swishdescription/ ],
59			swishtitle => [ qw/swishtitle/ ],
60			email => [ qw/email/ ],
61			name => [ qw/name/ ],
62			swishdocpath => [ qw/swishdocpath/ ],
63			},
64			},
65			date_ranges => {
66			property_name => 'sent', # property name to limit by
67			time_periods => [
68			'All',
69			'Today',
70			'Yesterday',
71			'This Week',
72			'Last Week',
73			'Last 90 Days',
74			'This Month',
75			'Last Month',
76			],
77
78			line_break => 0,
79			default => 'All',
80			date_range => 1,
81			},
82			};
83
84
85
86			=cut
87
88
89
90			use File::Find; # for recursing a directory tree
91			use Date::Parse;
92
93			# Recurse the directory(s) passed in on the command line
94
95			find( { wanted => \&wanted, no_chdir => 1, }, @ARGV );
96
97
98			sub wanted {
99			return if -d;
100			return unless m!(^\|/)\d+\.html$!;
101
102			my $mtime = (stat $File::Find::name )[9];
103
104			my $html = format_message($File::Find::name );
105			return unless $html;
106
107			my $size = length $html;
108
109			my $name = $File::Find::name;
110			$name =~ s[^./][];
111
112			print <<EOF;
113			Content-Length: $size
114			Last-Mtime: $mtime
115			Path-Name: $name
116
117			EOF
118
119			print $html;
120			}
121
122
123
124			sub format_message {
125			my $file = shift;
126			local $_;
127
128			unless ( open FH, "<$file" ) {
129			warn "Failed to open '$file'. Error: $!";
130			return;
131			}
132
133			my %fields;
134
135			while (<FH>) {
136			if ( my( $tag, $content) = /<!-- ([^=]+)="(.+)" -->$/ ) {
137			last if $tag eq 'body';
138
139			unless ( $content ) {
140			warn "File '$file' tag '$tag' empty content\n";
141			next;
142			}
143
144			if ( $tag eq 'sent' ) {
145			my $date = str2time $content;
146			unless ( defined $date ) {
147			warn "File '$file' tag '$tag' failed to parse '$content'\n";
148			next;
149			}
150			$content = $date;
151			}
152
153			if ( $tag eq 'received' ) {
154			my $date = str2time $content;
155			unless ( defined $date ) {
156			warn "File '$file' tag '$tag' failed to parse '$content'\n";
157			next;
158			}
159			$content = $date;
160			}
161
162
163			if ( $tag eq 'subject' ) {
164			$content =~ s/\Q[SWISH-E]\E//;
165			if ( $content =~ s/\sRe:\s//i ) {
166			$content .= ' (Re)';
167			}
168			}
169
170			$fields{$tag} = $content;
171			}
172			}
173
174			# Let's now use received header, if possible
175			$fields{sent} = $fields{received} \|\| $fields{sent};
176
177			my $body = '';
178
179			while ( <FH> ) {
180			last if /<!-- body="end" -->/ \|\| /^-- $/ \|\| /^--$/ \|\| /^(_\|-){40,}\s*$/;
181
182			$body .= $_;
183			}
184
185			return join "\n",
186			'<html>',
187			'<head>',
188			'<title>',
189			($fields{subject} \|\| '' ),
190			'</title>',
191			map( { qq[<meta name="$_" content="$fields{$_}">] } keys %fields ),
192			'</head><body>',
193			$body,
194			'</body>',
195			'</html>',
196			'';
197			}
198