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;

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