/[mws]/trunk/MWS_swish.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_swish.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 24 - (hide annotations)
Sat May 8 14:27:54 2004 UTC (20 years ago) by dpavlin
File size: 3126 byte(s)
another major update:
- sort is implemented
- search_filter from httpd.pl and all macros moved to macros.tt2
- URL parametars are now correctly escaped

1 dpavlin 12 #!/usr/bin/perl -w
2    
3     use strict;
4    
5     #
6     # simple implementation to use SWISH-e with queryies like
7     # Lucene (subject:something)
8     #
9    
10     use SWISH::API;
11 dpavlin 14 use Text::Iconv;
12     use Data::Dumper;
13 dpavlin 12
14 dpavlin 14 my $iso2utf = Text::Iconv->new('ISO-8859-2','UTF-8');
15     my $utf2iso = Text::Iconv->new('UTF-8','ISO-8859-2');
16    
17 dpavlin 12 sub open_index {
18     my $self = shift;
19    
20     my $swish = $self->{index};
21    
22     if (! $swish) {
23    
24     my $index_file = $self->{index_file} || croak "open_index needs index filename";
25     $index_file .= "/swish-e";
26     print STDERR "opening index '$index_file'\n";
27     $swish = SWISH::API->new($index_file);
28     $swish->AbortLastError if $swish->Error;
29    
30     $self->{index} = $swish;
31     }
32    
33     return $swish;
34     }
35    
36     sub search_index {
37     my $self = shift;
38    
39 dpavlin 21 croak "search_index needs query" if (! @_);
40 dpavlin 12
41     my $index = $self->open_index;
42    
43 dpavlin 21 my $sw;
44    
45 dpavlin 24 my $sort_map = {
46     'date' => 'date_utime',
47     'from' => 'from_phrase',
48     'to' => 'to_phrase',
49     'rank' => 'swishrank',
50     };
51    
52     my $sort_by;
53    
54 dpavlin 21 foreach my $s (@_) {
55    
56     if ($s =~ /^\s*(\w+):(.+)\s*$/) {
57 dpavlin 24 my ($f,$v) = ($1,$2);
58     if (lc($f) eq "sort") {
59     my ($sf,$sv) = split(/ /,$v,2);
60     $sort_by = $sort_map->{$sf} || croak "unsupported sort by field $v - fix sort_map";
61     $sort_by .= " $sv";
62     } else {
63     $sw .= "$f=($v)";
64     }
65 dpavlin 21 } else {
66     # and/or/not operators
67     $sw .= " $s ";
68     }
69 dpavlin 12 }
70    
71 dpavlin 21 print STDERR "swish search: $sw\n";
72 dpavlin 18
73     # convert to UTF-8
74 dpavlin 21 $sw = $iso2utf->convert($sw) || $sw;
75 dpavlin 12
76 dpavlin 24 my $search = $index->New_Search_Object;
77     $search->SetSort( $sort_by );
78     my $results = $search->Execute($sw);
79    
80 dpavlin 17 # store total number of hits
81     $self->{'total_hits'} = $results->Hits;
82    
83 dpavlin 14 my @res_ids;
84 dpavlin 12
85 dpavlin 18 my $count = 1;
86 dpavlin 17
87 dpavlin 14 while ( my $r = $results->NextResult ) {
88 dpavlin 13
89 dpavlin 14 sub p($$) {
90     my ($r,$prop) = @_;
91     $prop = $r->Property($prop);
92     $prop =~ s/##lf##/\n/gs;
93     return $utf2iso->convert($prop);
94     }
95 dpavlin 13
96 dpavlin 14 my $id = p($r,"swishdocpath");
97     push @res_ids, $id;
98    
99 dpavlin 13 foreach my $p (qw(from to cc bcc)) {
100 dpavlin 19 @{$self->{cache}->{$id}->{$p}} = ();
101     foreach my $v (split(/##/, p($r,$p.'_phrase'))) {
102     push @{$self->{cache}->{$id}->{$p}}, $v;
103     $self->add_counter($p,$v);
104     }
105 dpavlin 13 }
106    
107 dpavlin 23 foreach my $p (qw(subject body date date_utime)) {
108 dpavlin 14 $self->{cache}->{$id}->{$p} = p($r,$p);
109 dpavlin 13 }
110    
111 dpavlin 20 $self->add_counter_calendar(p($r,'date_utime'));
112    
113 dpavlin 13 # this is redundant, but needed for templates later...
114     $self->{cache}->{$id}->{'id'} = $id;
115 dpavlin 17
116 dpavlin 18 last if (++$count > $self->{max_results});
117 dpavlin 12 }
118    
119 dpavlin 14 return @res_ids;
120 dpavlin 12 }
121    
122     sub add_index {
123     my $self = shift;
124 dpavlin 14
125     my $mbox_id = shift || croak "add_index needs mbox_id";
126     my $document = shift || croak "add_index needs document";
127    
128     my ($mbox,$id) = split(/\s/,$mbox_id,2);
129    
130     my $xml = qq{<message>};
131     foreach my $tag (keys %$document) {
132     my $data = $document->{$tag};
133 dpavlin 16 next if (! $data || $data eq '');
134 dpavlin 14 # save [cr/]lf before conversion to XML
135     $data =~ s/\n\r/##lf##/gs;
136     $data =~ s/\n/##lf##/gs;
137 dpavlin 16 $xml .= "<$tag><![CDATA[".$data."]]></$tag>\n";
138 dpavlin 14 }
139     $xml .= qq{</message>};
140    
141     $xml = $iso2utf->convert($xml);
142     use bytes; # as opposed to chars
143     print "Path-Name: $mbox $id\n";
144     print "Content-Length: ".(length($xml)+1)."\n";
145     print "Document-Type: XML\n\n$xml\n";
146    
147 dpavlin 12 }
148    
149     sub close_index {
150     my $self = shift;
151    
152     }
153    
154     1;

  ViewVC Help
Powered by ViewVC 1.1.26