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'

 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( 'query phrase', 'result_template.tt', \@add_attr );

=cut

sub search {
        my ( $self, $query, $template, $add_attr ) = @_;

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

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

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

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

        $log->debug("loading " . ($#results + 1) . " 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	92
40	dpavlin	96	webpac:
41			db_path: '/data/webpac2/db'
42			template_path: '/data/webpac2/conf/output/tt'
43			template: 'html_ffzg_results_short.tt'
44			# encoding comming from webpac
45			webpac_encoding: 'iso-8859-2'
46			# encoding expected by Catalyst
47			out_encoding: 'UTF-8'
48
49	dpavlin	92	=cut
50
51			sub new {
52			my ( $self, $c, $config ) = @_;
53
54			$self = $self->NEXT::new($c, $config);
55			$self->config($config);
56
57			my $log = $c->log;
58	dpavlin	94	$self->{log} = $log;
59	dpavlin	92
60	dpavlin	93	my $est_cfg = $c->config->{hyperestraier};
61			$est_cfg->{'log'} = $log;
62	dpavlin	92
63	dpavlin	142	$est_cfg->{encoding} = $est_cfg->{catalyst_encoding};
64
65	dpavlin	93	$log->debug("using config:" . Dumper($est_cfg) );
66	dpavlin	92
67	dpavlin	93	$self->{est} = new WebPAC::Search::Estraier( %{ $est_cfg } );
68	dpavlin	92
69	dpavlin	95	my $db_path = $c->config->{webpac}->{db_path};
70			my $template_path = $c->config->{webpac}->{template_path};
71	dpavlin	135	$self->{template_path} = $template_path;
72	dpavlin	95
73			$log->debug("using db path '$db_path', template path '$template_path'");
74
75			$self->{db} = new WebPAC::DB(
76			path => $db_path,
77			read_only => 1,
78			);
79
80			$self->{out} = new WebPAC::Output::TT(
81			include_path => $template_path,
82			filters => { foo => sub { shift } },
83			);
84
85	dpavlin	101	# default template from config.yaml
86	dpavlin	95	$self->{template} \|\|= $c->config->{webpac}->{template};
87
88	dpavlin	96	$self->{iconv} = new Text::Iconv(
89			$c->config->{webpac}->{webpac_encoding},
90			$c->config->{webpac}->{out_encoding}
91			);
92
93	dpavlin	100	$log->debug("converting encoding from webpac_encoding '" .
94			$c->config->{webpac}->{webpac_encoding} .
95			"' to '" .
96			$c->config->{webpac}->{out_encoding} .
97	dpavlin	99	"'"
98			);
99	dpavlin	96
100	dpavlin	92	return $self;
101
102			}
103
104	dpavlin	135	=head2 iconv_on_save
105
106			my $out = $m->iconv_on_save( $content );
107
108			Convert data saved to disk in Webpac encoding.
109
110			=cut
111
112			sub iconv_on_save {
113			my $self = shift;
114
115			$self->{iconv_save} \|\|= new Text::Iconv(
116			$self->config->{webpac}->{out_encoding},
117			$self->config->{webpac}->{webpac_encoding},
118			);
119
120			$self->{iconv_save}->convert( @_ );
121			}
122
123
124			=head2 search
125
126			my $m->search( 'query phrase', 'result_template.tt', \@add_attr );
127
128			=cut
129
130	dpavlin	93	sub search {
131	dpavlin	119	my ( $self, $query, $template, $add_attr ) = @_;
132	dpavlin	93
133	dpavlin	95	my $log = $self->{log};
134	dpavlin	94
135	dpavlin	119	$log->debug("search model query: '$query', add_attr: '" . join("','", @{$add_attr}) . "'");
136	dpavlin	95
137	dpavlin	101	my $template_filename = $template \|\| $self->{template};
138	dpavlin	95
139	dpavlin	93	my @results = $self->{est}->search(
140	dpavlin	116	phrase => $query,
141			get_attr => [ '@uri' ],
142	dpavlin	93	max => 100,
143	dpavlin	119	add_attr => $add_attr,
144	dpavlin	93	);
145
146	dpavlin	99	$log->debug("loading " . ($#results + 1) . " results");
147
148	dpavlin	100	my @html_results;
149
150	dpavlin	95	for my $i ( 0 .. $#results ) {
151
152			my $mfn = $1 if ( $results[$i]->{'@uri'} =~ m#/(\d+)$#);
153
154	dpavlin	115	#$log->debug("load_ds( $mfn )");
155	dpavlin	95
156	dpavlin	115	my $ds = $self->{db}->load_ds( $mfn ) \|\| $log->error("can't load_ds( $mfn )") && next;
157	dpavlin	100
158	dpavlin	115	#$log->debug( "ds = " . Dumper( \@html_results ) );
159
160	dpavlin	100	my $html = $self->{out}->apply(
161	dpavlin	95	template => $template_filename,
162			data => $ds,
163	dpavlin	100	);
164
165			$html = $self->{iconv}->convert( $html ) \|\| $log->error("can't convert: $html");
166
167			push @html_results, $html;
168
169	dpavlin	95	}
170
171	dpavlin	115	#$log->debug( '@html_results = ' . Dumper( \@html_results ) );
172
173	dpavlin	100	return \@html_results;
174	dpavlin	93	}
175
176	dpavlin	135	=head2 save_html
177	dpavlin	93
178	dpavlin	135	$m->save_html( '/full/path/to/file', $content );
179	dpavlin	93
180	dpavlin	135	It will use C<iconv_on_save> to convert content encoding back to
181			Webpac codepage, recode JavaScript Unicode entities (%u1234),
182			strip extra newlines at beginning and end, and save to
183			C</full/path/to/file.new> and if that succeeds, just rename
184			it over original file which should be atomic on filesystem level.
185
186			=cut
187
188			sub save_html {
189			my ($self, $path, $content) = @_;
190
191			$content = $self->iconv_on_save( $content ) \|\| die "no content?";
192
193			sub _conv_js {
194			my $t = shift \|\| return;
195			return $self->{iconv}->convert(chr(hex($t)));
196			}
197			$content =~ s/%u([a-fA-F0-9]{4})/_conv_js($1)/gex;
198			$content =~ s/^[\n\r]+//s;
199			$content =~ s/[\n\r]+$/\n/s;
200
201			write_file($path . '.new', $content) \|\| die "can't save ${path}.new $!";
202			rename $path . '.new', $path \|\| die "can't rename to $path: $!";
203			}
204
205			=head2 load_html
206
207			my $html = $m->load_html('/full/path/to/file');
208
209			This will convert file from Webpac encoding to Catalyst and
210			convert that data to escaped HTML (for sending into
211			C<< <textarea/> >> tags in html.
212
213			=cut
214
215			sub load_html {
216			my ($self, $path) = @_;
217
218			die "no path?" unless ($path);
219
220			my $content = read_file($path) \|\| die "can't read $path: $!";
221			#$content = $q->escapeHTML($iconv_utf8->convert($content));
222			$content = $self->{iconv}->convert($content);
223
224			return $content;
225			}
226
227	dpavlin	92	=head1 AUTHOR
228
229			Dobrica Pavlinusic
230
231			=head1 LICENSE
232
233			This library is free software, you can redistribute it and/or modify
234			it under the same terms as Perl itself.
235
236			=cut
237
238			1;