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