/[webpac2]/trunk/lib/WebPAC/Output/Estraier.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

Diff of /trunk/lib/WebPAC/Output/Estraier.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1 by dpavlin, Sat Jun 25 20:23:23 2005 UTC revision 525 by dpavlin, Mon May 22 18:26:56 2006 UTC
# Line 3  package WebPAC::Output::Estraier; Line 3  package WebPAC::Output::Estraier;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6    use base qw/WebPAC::Common/;
7    
8    use Search::Estraier 0.06;
9    use Encode qw/from_to/;
10    use Data::Dumper;
11    use LWP;
12    use URI::Escape;
13    use List::Util qw/first/;
14    
15  =head1 NAME  =head1 NAME
16    
17  WebPAC::Output::Estraier - The great new WebPAC::Output::Estraier!  WebPAC::Output::Estraier - Create Hyper Estraier full text index
18    
19  =head1 VERSION  =head1 VERSION
20    
21  Version 0.01  Version 0.12
22    
23  =cut  =cut
24    
25  our $VERSION = '0.01';  our $VERSION = '0.12';
26    
27  =head1 SYNOPSIS  =head1 SYNOPSIS
28    
29  Quick summary of what the module does.  Create full text index using Hyper Estraier index from data with
30    type C<search>.
31    
32    =head1 FUNCTIONS
33    
34  Perhaps a little code snippet.  =head2 new
35    
36      use WebPAC::Output::Estraier;  Connect to Hyper Estraier index using HTTP
37    
38      my $foo = WebPAC::Output::Estraier->new();   my $est = new WebPAC::Output::Estraier(
39      ...          masterurl => 'http://localhost:1978/',
40            user => 'admin',
41            passwd => 'admin',
42            database => 'demo',
43            label => 'node label',
44            encoding => 'iso-8859-2',
45            clean => 1,
46     );
47    
48  =head1 EXPORT  Options are:
49    
50  A list of functions that can be exported.  You can delete this section  =over 4
 if you don't export anything, such as for a purely object-oriented module.  
51    
52  =head1 FUNCTIONS  =item masterurl
53    
54    URI to C<estmaster> node
55    
56    =item user
57    
58    C<estmaster> user with sufficient rights
59    
60    =item passwd
61    
62    password for user
63    
64    =item database
65    
66    name of database from which data comes
67    
68    =item label
69    
70    label for node (optional)
71    
72    =item encoding
73    
74    character encoding of C<data_structure> if it's differenet than C<ISO-8859-2>
75    (and it probably is). This encoding will be converted to C<UTF-8> for
76    Hyper Estraier.
77    
78    =back
79    
80    Name of database will be used to form URI of documents in index.
81    
82    =cut
83    
84    sub new {
85            my $class = shift;
86            my $self = {@_};
87            bless($self, $class);
88    
89            my $log = $self->_get_logger;
90    
91            #$log->debug("self: ", sub { Dumper($self) });
92    
93            foreach my $p (qw/masterurl user passwd database/) {
94                    $log->logdie("need $p") unless ($self->{$p});
95            }
96    
97            $self->{encoding} ||= 'ISO-8859-2';
98    
99            my $url = $self->{masterurl} . '/node/' . $self->{database};
100            $self->{url} = $url;
101    
102            $self->{label} ||= "WebPAC $self->{database}";
103    
104            $self->{db} = Search::Estraier::Node->new(
105                    url => $url,
106                    user => $self->{user},
107                    passwd => $self->{passwd},
108                    debug => $self->{debug},
109                    create => 1,
110                    label => $self->convert( $self->{label} ),
111            );
112    
113            $log->info("using ", $self->{clean} ? "new " : "", "index $self->{url} '$self->{label}' with encoding $self->{encoding}");
114    
115            if ($self->{clean}) {
116                    $log->debug("clean $self->{database}");
117                    $self->master( action => 'nodeclr', name => $self->{database} );
118            } else {
119                    $log->debug("opening index $self->{url}");
120            }
121    
122            $self ? return $self : return undef;
123    }
124    
125    
126    =head2 add
127    
128    Adds one entry to database.
129    
130      $est->add(
131            id => 42,
132            ds => $ds,
133            type => 'display',
134            text => 'optional text from which snippet is created',
135      );
136    
137    This function will create  entries in index using following URI format:
138    
139      C<file:///type/database%20name/000>
140    
141    Each tag in C<data_structure> with specified C<type> will create one
142    attribute and corresponding hidden text (used for search).
143    
144    =cut
145    
146  =head2 function1  sub add {
147            my $self = shift;
148    
149            my $args = {@_};
150    
151            my $log = $self->_get_logger;
152    
153            my $database = $self->{'database'} || $log->logconfess('no database in $self');
154            $log->logconfess('need db in object') unless ($self->{'db'});
155    
156            foreach my $p (qw/id ds type/) {
157                    $log->logdie("need $p") unless ($args->{$p});
158            }
159    
160            my $type = $args->{'type'};
161            my $id = $args->{'id'};
162    
163            my $uri = "file:///$type/$database/$id";
164            $log->debug("creating $uri");
165    
166            my $doc = Search::Estraier::Document->new;
167            $doc->add_attr('@uri', $self->convert($uri) );
168    
169            $log->debug("ds = ", sub { Dumper($args->{'ds'}) } );
170    
171            # filter all tags which have type defined
172            my @tags = grep {
173                    ref($args->{'ds'}->{$_}) eq 'HASH' && defined( $args->{'ds'}->{$_}->{$type} )
174            } keys %{ $args->{'ds'} };
175    
176            $log->debug("tags = ", join(",", @tags));
177    
178            return unless (@tags);
179    
180            foreach my $tag (@tags) {
181    
182                    my $vals = join(" ", @{ $args->{'ds'}->{$tag}->{$type} });
183    
184                    next if (! $vals);
185    
186                    $vals = $self->convert( $vals ) or
187                            $log->logdie("can't convert '$vals' to UTF-8");
188    
189                    $doc->add_attr( $tag, $vals );
190                    $doc->add_hidden_text( $vals );
191            }
192    
193            my $text = $args->{'text'};
194            if ( $text ) {
195                    $text = $self->convert( $text ) or
196                            $log->logdie("can't convert '$text' to UTF-8");
197                    $doc->add_text( $text );
198            }
199    
200            $log->debug("adding ", sub { $doc->dump_draft } );
201            $self->{'db'}->put_doc($doc) || $log->warn("can't add document $uri with draft " . $doc->dump_draft . " to node " . $self->{url} . " status: " . $self->{db}->status());
202    
203            return 1;
204    }
205    
206    =head2 add_link
207    
208      $est->add_link(
209            from => 'ps',
210            to => 'webpac2',
211            credit => 10000,
212      );
213    
214  =cut  =cut
215    
216  sub function1 {  sub add_link {
217            my $self = shift;
218    
219            my $args = {@_};
220            my $log = $self->_get_logger;
221    
222            my $node = first { $_->{name} eq $args->{to} } $self->master( action => 'nodelist' );
223    
224            if (! $node) {
225                    $log->warn("can't find node $args->{to}, skipping link creaton");
226                    return;
227            }
228    
229            my $label = $node->{label};
230    
231            if (! $label) {
232                    $log->warn("can't find label for $args->{to}, skipping link creaton");
233                    return;
234            }
235    
236            $log->debug("using label $label for $args->{to}");
237    
238            return $self->{db}->set_link(
239                    $self->{masterurl} . '/node/' . $args->{to},
240                    $label,
241                    $args->{credit},
242            );
243  }  }
244    
245  =head2 function2  
246    =head2 master
247    
248    Issue administrative commands to C<estmaster> process. See documentation for
249    C<master> in L<Search::Estraier>::Node.
250    
251      $self->master(
252            action => 'nodeclr',
253            name => 'foobar',
254      );
255    
256  =cut  =cut
257    
258  sub function2 {  sub master {
259            my $self = shift;
260            $self->{db}->master( @_ );
261  }  }
262    
 =head1 AUTHOR  
263    
264  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  =head2 convert
265    
266     my $utf8_string = $self->convert('string in codepage');
267    
268    =cut
269    
270  =head1 BUGS  sub convert {
271            my $self = shift;
272    
273  Please report any bugs or feature requests to          my $text = shift || return;
274  C<bug-webpac-output-estraier@rt.cpan.org>, or through the web interface at          from_to($text, $self->{encoding}, 'UTF-8');
275  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WebPAC>.          return $text;
276  I will be notified, and then you'll automatically be notified of progress on  }
 your bug as I make changes.  
277    
278  =head1 ACKNOWLEDGEMENTS  =head1 AUTHOR
279    
280    Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
281    
282  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
283    
Legend:
Removed from v.1  
changed lines
  Added in v.525
  ViewVC Help
Powered by ViewVC 1.1.26