Webpacus/Model/WebPAC.pm

package Webpacus::Model::WebPAC;

use strict;
use warnings;
use lib '/data/webpac2/lib';
use base qw/
        Catalyst::Model
/;
use Data::Dumper;
use WebPAC::DB;
use WebPAC::Output::TT;
use WebPAC::Search::Estraier 0.02;
use File::Slurp;

=head1 NAME

Webpacus::Model::WebPAC - Catalyst Model

=head1 SYNOPSIS

See L<Webpacus> and L<WebPAC>.

=head1 DESCRIPTION

Catalyst Model for access to WebPAC data.

=head2 new

Configuration for hyperestraier in C<config.yaml> like this:

 --- #YAML:1.0
 # DO NOT USE TABS FOR INDENTATION OR label/value SEPARATION!!!

 # configuration for hyper estraier full text search engine
 hyperestraier:
  url: 'http://localhost:1978/node/webpac2'
  user: 'admin'
  passwd: 'admin'
  hits_on_page: 100

 webpac:
  db_path: '/data/webpac2/db'
  template_path: '/data/webpac2/conf/output/tt'
  template: 'html_ffzg_results_short.tt'
  # encoding comming from webpac
  webpac_encoding: 'iso-8859-2'
  # encoding expected by Catalyst
  out_encoding: 'UTF-8'

=cut

sub new {
        my ( $self, $c, $config ) = @_;

        $self = $self->NEXT::new($c, $config);
        $self->config($config);

        my $log = $c->log;
        $self->{log} = $log;

        my $est_cfg = $c->config->{hyperestraier};
        $est_cfg->{'log'} = $log;

        $est_cfg->{encoding} = $est_cfg->{catalyst_encoding};

        $log->debug("using config:" . Dumper($est_cfg) );

        $self->{est} = new WebPAC::Search::Estraier( %{ $est_cfg } );

        my $db_path = $c->config->{webpac}->{db_path};
        my $template_path = $c->config->{webpac}->{template_path};
        $self->{template_path} = $template_path;

        $log->debug("using db path '$db_path', template path '$template_path'");

        $self->{db} = new WebPAC::DB(
                path => $db_path,
                read_only => 1,
        );

        $self->{out} = new WebPAC::Output::TT(
                include_path => $template_path,
                filters => { foo => sub { shift } },
        );

        # default template from config.yaml
        $self->{template} ||= $c->config->{webpac}->{template};

        $self->{iconv} = new Text::Iconv(
                $c->config->{webpac}->{webpac_encoding},
                $c->config->{webpac}->{out_encoding}
        );

        $log->debug("converting encoding from webpac_encoding '" .
                $c->config->{webpac}->{webpac_encoding} .
                "' to '" .
                $c->config->{webpac}->{out_encoding} .
                "'"
        );

        return $self;

}

=head2 iconv_on_save

  my $out = $m->iconv_on_save( $content );

Convert data saved to disk in Webpac encoding.

=cut

sub iconv_on_save {
        my $self = shift;

        $self->{iconv_save} ||= new Text::Iconv(
                $self->config->{webpac}->{out_encoding},
                $self->config->{webpac}->{webpac_encoding},
        );

        $self->{iconv_save}->convert( @_ );
}


=head2 search

  my $m->search(
        phrase => 'query phrase',
        template => 'result_template.tt',
        add_attr => \@add_attr
  );

=cut

sub search {
        my $self = shift;

        my $args = {@_};

        my $log = $self->{log};

        $log->debug("args: " . Dumper( $args ));

        my $query = $args->{phrase} || $log->warn("no query phrase") && return;

        $log->debug("search model query: '$query', add_attr: '" . join("','", @{$args->{add_attr}}) . "'");

        my $template_filename = $args->{template} || $self->{template};

        my @results = $self->{est}->search(
                phrase => $query,
                get_attr => [ '@uri' ],
                max => ( $self->{est}->{hits_on_page} || 30 ),
                add_attr => $args->{add_attr},
        );

        my $hits = $#results + 1;

        $log->debug("processing $hits results");

        my @html_results;

        for my $i ( 0 .. $#results ) {

                my $mfn = $1 if ( $results[$i]->{'@uri'} =~ m#/(\d+)$#);

                #$log->debug("load_ds( $mfn )");

                my $ds = $self->{db}->load_ds( $mfn ) || $log->error("can't load_ds( $mfn )") && next;
        
                #$log->debug( "ds = " . Dumper( \@html_results ) );

                my $html = $self->{out}->apply(
                        template => $template_filename,
                        data => $ds,
                );

                $html = $self->{iconv}->convert( $html ) || $log->error("can't convert: $html");

                push @html_results, $html;

        }

        #$log->debug( '@html_results = ' . Dumper( \@html_results ) );

        return \@html_results;
}

=head2 save_html

  $m->save_html( '/full/path/to/file', $content );

It will use C<iconv_on_save> to convert content encoding back to
Webpac codepage, recode JavaScript Unicode entities (%u1234),
strip extra newlines at beginning and end, and save to 
C</full/path/to/file.new> and if that succeeds, just rename
it over original file which should be atomic on filesystem level.

=cut

sub save_html {
        my ($self, $path, $content) = @_;

        $content = $self->iconv_on_save( $content ) || die "no content?";

        sub _conv_js {
                my $t = shift || return;
                return $self->{iconv}->convert(chr(hex($t)));
        }
        $content =~ s/%u([a-fA-F0-9]{4})/_conv_js($1)/gex;
        $content =~ s/^[\n\r]+//s;
        $content =~ s/[\n\r]+$/\n/s;

        write_file($path . '.new', $content) || die "can't save ${path}.new $!";
        rename $path . '.new', $path || die "can't rename to $path: $!";
}

=head2 load_html

  my $html = $m->load_html('/full/path/to/file');

This will convert file from Webpac encoding to Catalyst and
convert that data to escaped HTML (for sending into
C<< <textarea/> >> tags in html.

=cut

sub load_html {
        my ($self, $path) = @_;

        die "no path?" unless ($path);

        my $content = read_file($path) || die "can't read $path: $!";
        #$content = $q->escapeHTML($iconv_utf8->convert($content));
        $content = $self->{iconv}->convert($content);

        return $content;
}

=head1 AUTHOR

Dobrica Pavlinusic

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;
1	dpavlin	92	package Webpacus::Model::WebPAC;
2
3			use strict;
4			use warnings;
5			use lib '/data/webpac2/lib';
6	dpavlin	93	use base qw/
7			Catalyst::Model
8			/;
9	dpavlin	92	use Data::Dumper;
10	dpavlin	95	use WebPAC::DB;
11			use WebPAC::Output::TT;
12	dpavlin	116	use WebPAC::Search::Estraier 0.02;
13	dpavlin	135	use File::Slurp;
14	dpavlin	92
15			=head1 NAME
16
17			Webpacus::Model::WebPAC - Catalyst Model
18
19			=head1 SYNOPSIS
20
21			See L<Webpacus> and L<WebPAC>.
22
23			=head1 DESCRIPTION
24
25			Catalyst Model for access to WebPAC data.
26
27			=head2 new
28
29			Configuration for hyperestraier in C<config.yaml> like this:
30
31			--- #YAML:1.0
32			# DO NOT USE TABS FOR INDENTATION OR label/value SEPARATION!!!
33
34			# configuration for hyper estraier full text search engine
35			hyperestraier:
36	dpavlin	96	url: 'http://localhost:1978/node/webpac2'
37			user: 'admin'
38			passwd: 'admin'
39	dpavlin	143	hits_on_page: 100
40	dpavlin	92
41	dpavlin	96	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	dpavlin	92	=cut
51
52			sub new {
53			my ( $self, $c, $config ) = @_;
54
55			$self = $self->NEXT::new($c, $config);
56			$self->config($config);
57
58			my $log = $c->log;
59	dpavlin	94	$self->{log} = $log;
60	dpavlin	92
61	dpavlin	93	my $est_cfg = $c->config->{hyperestraier};
62			$est_cfg->{'log'} = $log;
63	dpavlin	92
64	dpavlin	142	$est_cfg->{encoding} = $est_cfg->{catalyst_encoding};
65
66	dpavlin	93	$log->debug("using config:" . Dumper($est_cfg) );
67	dpavlin	92
68	dpavlin	93	$self->{est} = new WebPAC::Search::Estraier( %{ $est_cfg } );
69	dpavlin	92
70	dpavlin	95	my $db_path = $c->config->{webpac}->{db_path};
71			my $template_path = $c->config->{webpac}->{template_path};
72	dpavlin	135	$self->{template_path} = $template_path;
73	dpavlin	95
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	dpavlin	101	# default template from config.yaml
87	dpavlin	95	$self->{template} \|\|= $c->config->{webpac}->{template};
88
89	dpavlin	96	$self->{iconv} = new Text::Iconv(
90			$c->config->{webpac}->{webpac_encoding},
91			$c->config->{webpac}->{out_encoding}
92			);
93
94	dpavlin	100	$log->debug("converting encoding from webpac_encoding '" .
95			$c->config->{webpac}->{webpac_encoding} .
96			"' to '" .
97			$c->config->{webpac}->{out_encoding} .
98	dpavlin	99	"'"
99			);
100	dpavlin	96
101	dpavlin	92	return $self;
102
103			}
104
105	dpavlin	135	=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	dpavlin	150	my $m->search(
128			phrase => 'query phrase',
129			template => 'result_template.tt',
130			add_attr => \@add_attr
131			);
132	dpavlin	135
133			=cut
134
135	dpavlin	93	sub search {
136	dpavlin	150	my $self = shift;
137	dpavlin	93
138	dpavlin	150	my $args = {@_};
139
140	dpavlin	95	my $log = $self->{log};
141	dpavlin	94
142	dpavlin	150	$log->debug("args: " . Dumper( $args ));
143	dpavlin	95
144	dpavlin	150	my $query = $args->{phrase} \|\| $log->warn("no query phrase") && return;
145	dpavlin	95
146	dpavlin	150	$log->debug("search model query: '$query', add_attr: '" . join("','", @{$args->{add_attr}}) . "'");
147
148			my $template_filename = $args->{template} \|\| $self->{template};
149
150	dpavlin	93	my @results = $self->{est}->search(
151	dpavlin	116	phrase => $query,
152			get_attr => [ '@uri' ],
153	dpavlin	150	max => ( $self->{est}->{hits_on_page} \|\| 30 ),
154			add_attr => $args->{add_attr},
155	dpavlin	93	);
156
157	dpavlin	150	my $hits = $#results + 1;
158	dpavlin	99
159	dpavlin	150	$log->debug("processing $hits results");
160
161	dpavlin	100	my @html_results;
162
163	dpavlin	95	for my $i ( 0 .. $#results ) {
164
165			my $mfn = $1 if ( $results[$i]->{'@uri'} =~ m#/(\d+)$#);
166
167	dpavlin	115	#$log->debug("load_ds( $mfn )");
168	dpavlin	95
169	dpavlin	115	my $ds = $self->{db}->load_ds( $mfn ) \|\| $log->error("can't load_ds( $mfn )") && next;
170	dpavlin	100
171	dpavlin	115	#$log->debug( "ds = " . Dumper( \@html_results ) );
172
173	dpavlin	100	my $html = $self->{out}->apply(
174	dpavlin	95	template => $template_filename,
175			data => $ds,
176	dpavlin	100	);
177
178			$html = $self->{iconv}->convert( $html ) \|\| $log->error("can't convert: $html");
179
180			push @html_results, $html;
181
182	dpavlin	95	}
183
184	dpavlin	115	#$log->debug( '@html_results = ' . Dumper( \@html_results ) );
185
186	dpavlin	100	return \@html_results;
187	dpavlin	93	}
188
189	dpavlin	135	=head2 save_html
190	dpavlin	93
191	dpavlin	135	$m->save_html( '/full/path/to/file', $content );
192	dpavlin	93
193	dpavlin	135	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	dpavlin	92	=head1 AUTHOR
241
242			Dobrica Pavlinusic
243
244			=head1 LICENSE
245
246			This library is free software, you can redistribute it and/or modify
247			it under the same terms as Perl itself.
248
249			=cut
250
251			1;