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( '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 => $self->{est}->{hits_on_page} || 30,
                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	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			my $m->search( 'query phrase', 'result_template.tt', \@add_attr );
128
129			=cut
130
131	dpavlin	93	sub search {
132	dpavlin	119	my ( $self, $query, $template, $add_attr ) = @_;
133	dpavlin	93
134	dpavlin	95	my $log = $self->{log};
135	dpavlin	94
136	dpavlin	119	$log->debug("search model query: '$query', add_attr: '" . join("','", @{$add_attr}) . "'");
137	dpavlin	95
138	dpavlin	101	my $template_filename = $template \|\| $self->{template};
139	dpavlin	95
140	dpavlin	93	my @results = $self->{est}->search(
141	dpavlin	116	phrase => $query,
142			get_attr => [ '@uri' ],
143	dpavlin	143	max => $self->{est}->{hits_on_page} \|\| 30,
144	dpavlin	119	add_attr => $add_attr,
145	dpavlin	93	);
146
147	dpavlin	99	$log->debug("loading " . ($#results + 1) . " results");
148
149	dpavlin	100	my @html_results;
150
151	dpavlin	95	for my $i ( 0 .. $#results ) {
152
153			my $mfn = $1 if ( $results[$i]->{'@uri'} =~ m#/(\d+)$#);
154
155	dpavlin	115	#$log->debug("load_ds( $mfn )");
156	dpavlin	95
157	dpavlin	115	my $ds = $self->{db}->load_ds( $mfn ) \|\| $log->error("can't load_ds( $mfn )") && next;
158	dpavlin	100
159	dpavlin	115	#$log->debug( "ds = " . Dumper( \@html_results ) );
160
161	dpavlin	100	my $html = $self->{out}->apply(
162	dpavlin	95	template => $template_filename,
163			data => $ds,
164	dpavlin	100	);
165
166			$html = $self->{iconv}->convert( $html ) \|\| $log->error("can't convert: $html");
167
168			push @html_results, $html;
169
170	dpavlin	95	}
171
172	dpavlin	115	#$log->debug( '@html_results = ' . Dumper( \@html_results ) );
173
174	dpavlin	100	return \@html_results;
175	dpavlin	93	}
176
177	dpavlin	135	=head2 save_html
178	dpavlin	93
179	dpavlin	135	$m->save_html( '/full/path/to/file', $content );
180	dpavlin	93
181	dpavlin	135	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	dpavlin	92	=head1 AUTHOR
229
230			Dobrica Pavlinusic
231
232			=head1 LICENSE
233
234			This library is free software, you can redistribute it and/or modify
235			it under the same terms as Perl itself.
236
237			=cut
238
239			1;