/[webpac2]/Webpacus/lib/Webpacus/Model/WebPAC.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 /Webpacus/lib/Webpacus/Model/WebPAC.pm

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

revision 94 by dpavlin, Tue Nov 22 12:57:20 2005 UTC revision 150 by dpavlin, Fri Nov 25 19:19:55 2005 UTC
# Line 5  use warnings; Line 5  use warnings;
5  use lib '/data/webpac2/lib';  use lib '/data/webpac2/lib';
6  use base qw/  use base qw/
7          Catalyst::Model          Catalyst::Model
         WebPAC::Search::Estraier  
8  /;  /;
9  use Data::Dumper;  use Data::Dumper;
10    use WebPAC::DB;
11    use WebPAC::Output::TT;
12    use WebPAC::Search::Estraier 0.02;
13    use File::Slurp;
14    
15  =head1 NAME  =head1 NAME
16    
# Line 30  Configuration for hyperestraier in C<con Line 33  Configuration for hyperestraier in C<con
33    
34   # configuration for hyper estraier full text search engine   # configuration for hyper estraier full text search engine
35   hyperestraier:   hyperestraier:
36      url: 'http://localhost:1978/node/webpac2'    url: 'http://localhost:1978/node/webpac2'
37      user: 'admin'    user: 'admin'
38      passwd: 'admin'    passwd: 'admin'
39      hits_on_page: 100
40    
41     webpac:
42      db_path: '/data/webpac2/db'
43      template_path: '/data/webpac2/conf/output/tt'
44      template: 'html_ffzg_results_short.tt'
45      # encoding comming from webpac
46      webpac_encoding: 'iso-8859-2'
47      # encoding expected by Catalyst
48      out_encoding: 'UTF-8'
49    
50  =cut  =cut
51    
# Line 48  sub new { Line 61  sub new {
61          my $est_cfg = $c->config->{hyperestraier};          my $est_cfg = $c->config->{hyperestraier};
62          $est_cfg->{'log'} = $log;          $est_cfg->{'log'} = $log;
63    
64            $est_cfg->{encoding} = $est_cfg->{catalyst_encoding};
65    
66          $log->debug("using config:" . Dumper($est_cfg) );          $log->debug("using config:" . Dumper($est_cfg) );
67    
68          $self->{est} = new WebPAC::Search::Estraier( %{ $est_cfg } );          $self->{est} = new WebPAC::Search::Estraier( %{ $est_cfg } );
69    
70            my $db_path = $c->config->{webpac}->{db_path};
71            my $template_path = $c->config->{webpac}->{template_path};
72            $self->{template_path} = $template_path;
73    
74            $log->debug("using db path '$db_path', template path '$template_path'");
75    
76            $self->{db} = new WebPAC::DB(
77                    path => $db_path,
78                    read_only => 1,
79            );
80    
81            $self->{out} = new WebPAC::Output::TT(
82                    include_path => $template_path,
83                    filters => { foo => sub { shift } },
84            );
85    
86            # default template from config.yaml
87            $self->{template} ||= $c->config->{webpac}->{template};
88    
89            $self->{iconv} = new Text::Iconv(
90                    $c->config->{webpac}->{webpac_encoding},
91                    $c->config->{webpac}->{out_encoding}
92            );
93    
94            $log->debug("converting encoding from webpac_encoding '" .
95                    $c->config->{webpac}->{webpac_encoding} .
96                    "' to '" .
97                    $c->config->{webpac}->{out_encoding} .
98                    "'"
99            );
100    
101          return $self;          return $self;
102    
103  }  }
104    
105    =head2 iconv_on_save
106    
107      my $out = $m->iconv_on_save( $content );
108    
109    Convert data saved to disk in Webpac encoding.
110    
111    =cut
112    
113    sub iconv_on_save {
114            my $self = shift;
115    
116            $self->{iconv_save} ||= new Text::Iconv(
117                    $self->config->{webpac}->{out_encoding},
118                    $self->config->{webpac}->{webpac_encoding},
119            );
120    
121            $self->{iconv_save}->convert( @_ );
122    }
123    
124    
125    =head2 search
126    
127      my $m->search(
128            phrase => 'query phrase',
129            template => 'result_template.tt',
130            add_attr => \@add_attr
131      );
132    
133    =cut
134    
135  sub search {  sub search {
136          my ( $self, $query ) = @_;          my $self = shift;
137    
138            my $args = {@_};
139    
140            my $log = $self->{log};
141    
142            $log->debug("args: " . Dumper( $args ));
143    
144          $self->{log}->debug("search got query: $query<--");          my $query = $args->{phrase} || $log->warn("no query phrase") && return;
145    
146            $log->debug("search model query: '$query', add_attr: '" . join("','", @{$args->{add_attr}}) . "'");
147    
148            my $template_filename = $args->{template} || $self->{template};
149    
150          my @results = $self->{est}->search(          my @results = $self->{est}->search(
151                  query => $query,                  phrase => $query,
152                  attr => [ '@uri' ],                  get_attr => [ '@uri' ],
153                  max => 100,                  max => ( $self->{est}->{hits_on_page} || 30 ),
154                    add_attr => $args->{add_attr},
155          );          );
156    
157          return @results;          my $hits = $#results + 1;
 }  
158    
159            $log->debug("processing $hits results");
160    
161            my @html_results;
162    
163            for my $i ( 0 .. $#results ) {
164    
165                    my $mfn = $1 if ( $results[$i]->{'@uri'} =~ m#/(\d+)$#);
166    
167                    #$log->debug("load_ds( $mfn )");
168    
169                    my $ds = $self->{db}->load_ds( $mfn ) || $log->error("can't load_ds( $mfn )") && next;
170                    
171                    #$log->debug( "ds = " . Dumper( \@html_results ) );
172    
173                    my $html = $self->{out}->apply(
174                            template => $template_filename,
175                            data => $ds,
176                    );
177    
178                    $html = $self->{iconv}->convert( $html ) || $log->error("can't convert: $html");
179    
180                    push @html_results, $html;
181    
182            }
183    
184            #$log->debug( '@html_results = ' . Dumper( \@html_results ) );
185    
186            return \@html_results;
187    }
188    
189    =head2 save_html
190    
191      $m->save_html( '/full/path/to/file', $content );
192    
193    It will use C<iconv_on_save> to convert content encoding back to
194    Webpac codepage, recode JavaScript Unicode entities (%u1234),
195    strip extra newlines at beginning and end, and save to
196    C</full/path/to/file.new> and if that succeeds, just rename
197    it over original file which should be atomic on filesystem level.
198    
199    =cut
200    
201    sub save_html {
202            my ($self, $path, $content) = @_;
203    
204            $content = $self->iconv_on_save( $content ) || die "no content?";
205    
206            sub _conv_js {
207                    my $t = shift || return;
208                    return $self->{iconv}->convert(chr(hex($t)));
209            }
210            $content =~ s/%u([a-fA-F0-9]{4})/_conv_js($1)/gex;
211            $content =~ s/^[\n\r]+//s;
212            $content =~ s/[\n\r]+$/\n/s;
213    
214            write_file($path . '.new', $content) || die "can't save ${path}.new $!";
215            rename $path . '.new', $path || die "can't rename to $path: $!";
216    }
217    
218    =head2 load_html
219    
220      my $html = $m->load_html('/full/path/to/file');
221    
222    This will convert file from Webpac encoding to Catalyst and
223    convert that data to escaped HTML (for sending into
224    C<< <textarea/> >> tags in html.
225    
226    =cut
227    
228    sub load_html {
229            my ($self, $path) = @_;
230    
231            die "no path?" unless ($path);
232    
233            my $content = read_file($path) || die "can't read $path: $!";
234            #$content = $q->escapeHTML($iconv_utf8->convert($content));
235            $content = $self->{iconv}->convert($content);
236    
237            return $content;
238    }
239    
240  =head1 AUTHOR  =head1 AUTHOR
241    
Legend:
Removed from v.94  
changed lines
  Added in v.150
  ViewVC Help
Powered by ViewVC 1.1.26