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;

=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};

        $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;

}

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;
}


=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	92
14			=head1 NAME
15
16			Webpacus::Model::WebPAC - Catalyst Model
17
18			=head1 SYNOPSIS
19
20			See L<Webpacus> and L<WebPAC>.
21
22			=head1 DESCRIPTION
23
24			Catalyst Model for access to WebPAC data.
25
26			=head2 new
27
28			Configuration for hyperestraier in C<config.yaml> like this:
29
30			--- #YAML:1.0
31			# DO NOT USE TABS FOR INDENTATION OR label/value SEPARATION!!!
32
33			# configuration for hyper estraier full text search engine
34			hyperestraier:
35	dpavlin	96	url: 'http://localhost:1978/node/webpac2'
36			user: 'admin'
37			passwd: 'admin'
38	dpavlin	92
39	dpavlin	96	webpac:
40			db_path: '/data/webpac2/db'
41			template_path: '/data/webpac2/conf/output/tt'
42			template: 'html_ffzg_results_short.tt'
43			# encoding comming from webpac
44			webpac_encoding: 'iso-8859-2'
45			# encoding expected by Catalyst
46			out_encoding: 'UTF-8'
47
48	dpavlin	92	=cut
49
50			sub new {
51			my ( $self, $c, $config ) = @_;
52
53			$self = $self->NEXT::new($c, $config);
54			$self->config($config);
55
56			my $log = $c->log;
57	dpavlin	94	$self->{log} = $log;
58	dpavlin	92
59	dpavlin	93	my $est_cfg = $c->config->{hyperestraier};
60			$est_cfg->{'log'} = $log;
61	dpavlin	92
62	dpavlin	93	$log->debug("using config:" . Dumper($est_cfg) );
63	dpavlin	92
64	dpavlin	93	$self->{est} = new WebPAC::Search::Estraier( %{ $est_cfg } );
65	dpavlin	92
66	dpavlin	95	my $db_path = $c->config->{webpac}->{db_path};
67			my $template_path = $c->config->{webpac}->{template_path};
68
69			$log->debug("using db path '$db_path', template path '$template_path'");
70
71			$self->{db} = new WebPAC::DB(
72			path => $db_path,
73			read_only => 1,
74			);
75
76			$self->{out} = new WebPAC::Output::TT(
77			include_path => $template_path,
78			filters => { foo => sub { shift } },
79			);
80
81	dpavlin	101	# default template from config.yaml
82	dpavlin	95	$self->{template} \|\|= $c->config->{webpac}->{template};
83
84	dpavlin	96	$self->{iconv} = new Text::Iconv(
85			$c->config->{webpac}->{webpac_encoding},
86			$c->config->{webpac}->{out_encoding}
87			);
88
89	dpavlin	100	$log->debug("converting encoding from webpac_encoding '" .
90			$c->config->{webpac}->{webpac_encoding} .
91			"' to '" .
92			$c->config->{webpac}->{out_encoding} .
93	dpavlin	99	"'"
94			);
95	dpavlin	96
96	dpavlin	92	return $self;
97
98			}
99
100	dpavlin	93	sub search {
101	dpavlin	119	my ( $self, $query, $template, $add_attr ) = @_;
102	dpavlin	93
103	dpavlin	95	my $log = $self->{log};
104	dpavlin	94
105	dpavlin	119	$log->debug("search model query: '$query', add_attr: '" . join("','", @{$add_attr}) . "'");
106	dpavlin	95
107	dpavlin	101	my $template_filename = $template \|\| $self->{template};
108	dpavlin	95
109	dpavlin	93	my @results = $self->{est}->search(
110	dpavlin	116	phrase => $query,
111			get_attr => [ '@uri' ],
112	dpavlin	93	max => 100,
113	dpavlin	119	add_attr => $add_attr,
114	dpavlin	93	);
115
116	dpavlin	99	$log->debug("loading " . ($#results + 1) . " results");
117
118	dpavlin	100	my @html_results;
119
120	dpavlin	95	for my $i ( 0 .. $#results ) {
121
122			my $mfn = $1 if ( $results[$i]->{'@uri'} =~ m#/(\d+)$#);
123
124	dpavlin	115	#$log->debug("load_ds( $mfn )");
125	dpavlin	95
126	dpavlin	115	my $ds = $self->{db}->load_ds( $mfn ) \|\| $log->error("can't load_ds( $mfn )") && next;
127	dpavlin	100
128	dpavlin	115	#$log->debug( "ds = " . Dumper( \@html_results ) );
129
130	dpavlin	100	my $html = $self->{out}->apply(
131	dpavlin	95	template => $template_filename,
132			data => $ds,
133	dpavlin	100	);
134
135			$html = $self->{iconv}->convert( $html ) \|\| $log->error("can't convert: $html");
136
137			push @html_results, $html;
138
139	dpavlin	95	}
140
141	dpavlin	115	#$log->debug( '@html_results = ' . Dumper( \@html_results ) );
142
143	dpavlin	100	return \@html_results;
144	dpavlin	93	}
145
146
147
148
149	dpavlin	92	=head1 AUTHOR
150
151			Dobrica Pavlinusic
152
153			=head1 LICENSE
154
155			This library is free software, you can redistribute it and/or modify
156			it under the same terms as Perl itself.
157
158			=cut
159
160			1;