/[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 96 by dpavlin, Tue Nov 22 12:57:30 2005 UTC revision 143 by dpavlin, Fri Nov 25 01:24:31 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;  use WebPAC::DB;
11  use WebPAC::Output::TT;  use WebPAC::Output::TT;
12    use WebPAC::Search::Estraier 0.02;
13    use File::Slurp;
14    
15  =head1 NAME  =head1 NAME
16    
# Line 35  Configuration for hyperestraier in C<con Line 36  Configuration for hyperestraier in C<con
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:   webpac:
42    db_path: '/data/webpac2/db'    db_path: '/data/webpac2/db'
# Line 59  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};          my $db_path = $c->config->{webpac}->{db_path};
71          my $template_path = $c->config->{webpac}->{template_path};          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'");          $log->debug("using db path '$db_path', template path '$template_path'");
75    
# Line 78  sub new { Line 83  sub new {
83                  filters => { foo => sub { shift } },                  filters => { foo => sub { shift } },
84          );          );
85    
86            # default template from config.yaml
87          $self->{template} ||= $c->config->{webpac}->{template};          $self->{template} ||= $c->config->{webpac}->{template};
88    
89          $self->{iconv} = new Text::Iconv(          $self->{iconv} = new Text::Iconv(
# Line 85  sub new { Line 91  sub new {
91                  $c->config->{webpac}->{out_encoding}                  $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( 'query phrase', 'result_template.tt', \@add_attr );
128    
129    =cut
130    
131  sub search {  sub search {
132          my ( $self, $query ) = @_;          my ( $self, $query, $template, $add_attr ) = @_;
133    
134          my $log = $self->{log};          my $log = $self->{log};
135    
136          $log->debug("search got query: $query<--");          $log->debug("search model query: '$query', add_attr: '" . join("','", @{$add_attr}) . "'");
137    
138          my $template_filename = $self->{template};          my $template_filename = $template || $self->{template};
139    
140          my @results = $self->{est}->search(          my @results = $self->{est}->search(
141                  query => $query,                  phrase => $query,
142                  attr => [ '@uri' ],                  get_attr => [ '@uri' ],
143                  max => 100,                  max => $self->{est}->{hits_on_page} || 30,
144                    add_attr => $add_attr,
145          );          );
146    
147            $log->debug("loading " . ($#results + 1) . " results");
148    
149            my @html_results;
150    
151          for my $i ( 0 .. $#results ) {          for my $i ( 0 .. $#results ) {
152    
153                  my $mfn = $1 if ( $results[$i]->{'@uri'} =~ m#/(\d+)$#);                  my $mfn = $1 if ( $results[$i]->{'@uri'} =~ m#/(\d+)$#);
154    
155                  $log->debug("load_ds( $mfn )");                  #$log->debug("load_ds( $mfn )");
156    
157                    my $ds = $self->{db}->load_ds( $mfn ) || $log->error("can't load_ds( $mfn )") && next;
158            
159                    #$log->debug( "ds = " . Dumper( \@html_results ) );
160    
161                  my $ds = $self->{db}->load_ds( $mfn ) || next;                  my $html = $self->{out}->apply(
                 $results[$i]->{ html } = $self->{iconv}->convert(  
                 $self->{out}->apply(  
162                          template => $template_filename,                          template => $template_filename,
163                          data => $ds,                          data => $ds,
164                  ) );                  );
165    
166                    $html = $self->{iconv}->convert( $html ) || $log->error("can't convert: $html");
167    
168                    push @html_results, $html;
169    
170          }          }
171    
172          return \@results;          #$log->debug( '@html_results = ' . Dumper( \@html_results ) );
173    
174            return \@html_results;
175  }  }
176    
177    =head2 save_html
178    
179              $m->save_html( '/full/path/to/file', $content );
180    
181    It will use C<iconv_on_save> to convert content encoding back to
182    Webpac codepage, recode JavaScript Unicode entities (%u1234),
183    strip extra newlines at beginning and end, and save to
184    C</full/path/to/file.new> and if that succeeds, just rename
185    it over original file which should be atomic on filesystem level.
186    
187    =cut
188    
189    sub save_html {
190            my ($self, $path, $content) = @_;
191    
192            $content = $self->iconv_on_save( $content ) || die "no content?";
193    
194            sub _conv_js {
195                    my $t = shift || return;
196                    return $self->{iconv}->convert(chr(hex($t)));
197            }
198            $content =~ s/%u([a-fA-F0-9]{4})/_conv_js($1)/gex;
199            $content =~ s/^[\n\r]+//s;
200            $content =~ s/[\n\r]+$/\n/s;
201    
202            write_file($path . '.new', $content) || die "can't save ${path}.new $!";
203            rename $path . '.new', $path || die "can't rename to $path: $!";
204    }
205    
206    =head2 load_html
207    
208      my $html = $m->load_html('/full/path/to/file');
209    
210    This will convert file from Webpac encoding to Catalyst and
211    convert that data to escaped HTML (for sending into
212    C<< <textarea/> >> tags in html.
213    
214    =cut
215    
216    sub load_html {
217            my ($self, $path) = @_;
218    
219            die "no path?" unless ($path);
220    
221            my $content = read_file($path) || die "can't read $path: $!";
222            #$content = $q->escapeHTML($iconv_utf8->convert($content));
223            $content = $self->{iconv}->convert($content);
224    
225            return $content;
226    }
227    
228  =head1 AUTHOR  =head1 AUTHOR
229    
Legend:
Removed from v.96  
changed lines
  Added in v.143
  ViewVC Help
Powered by ViewVC 1.1.26