added header_first to WebPAC::Input::CSV
[webpac2] / lib / WebPAC / Output / Webpacus.pm
1 package WebPAC::Output::Webpacus;
2
3 use warnings;
4 use strict;
5
6 use base qw/WebPAC::Common WebPAC::Output Class::Accessor/;
7 __PACKAGE__->mk_accessors(qw(
8         path
9         database
10         input
11 ));
12
13 use File::Path;
14 use Data::Dump qw/dump/;
15 use WebPAC::Common qw/force_array/;
16 use Carp qw/confess/;
17 use Cwd;
18 use File::Slurp;
19
20 use Jifty;
21
22 =head1 NAME
23
24 WebPAC::Output::Webpacus - integrate WebPAC front-end with Jifty back-end
25
26 =cut
27
28 our $VERSION = '0.03';
29
30 =head1 SYNOPSIS
31
32 Does black magic to sync data between WebPAC and Webpacus, web front-end
33 implement in Jifty
34
35 =head1 FUNCTIONS
36
37 =head2 new
38
39  my $output = new WebPAC::Output::Webpacus({
40         path => '/path/to/Webpacus',
41         database => 'demo',
42  });
43
44 =head2 init
45
46  $output->init;
47
48 =cut
49
50 sub init {
51         my $self = shift;
52
53         my $log = $self->_get_logger;
54
55         foreach my $p (qw/path database/) {
56                 $log->logdie("need $p") unless ($self->$p);
57         }
58
59         my $path = $self->path;
60
61         $log->logdie("Webpacus path $path not found: $!") unless -d $path;
62
63         my $config_path = "$path/etc/config.yml";
64
65         $log->logdie("expected Webpacus config at $config_path: $!") unless -e $config_path;
66
67         $self->{fields} = {};
68
69 }
70
71
72 =head2 add
73
74 Adds one entry
75
76   $est->add( 42, $ds );
77
78 =cut
79
80 sub add {
81         my $self = shift;
82
83         my ( $id, $ds ) = @_;
84
85         my $log = $self->_get_logger;
86         $log->logdie("need id") unless defined $id;
87         $log->logdie("need ds") unless $ds;
88
89         $log->debug("id: $id ds = ",sub { dump($ds) });
90
91         my $stat;
92
93         foreach my $type ( $self->consume_outputs ) {
94
95                 my $hash = $self->ds_to_hash( $ds, $type ) || next;
96
97                 $log->debug("$type has following data: ", sub { dump( $hash ) });
98
99                 foreach my $f ( keys %$hash ) {
100                         $self->{fields}->{$type}->{$f}++;
101                         $stat->{$type}->{$f}++;
102                 }
103         }
104
105         $log->debug("this record added following fields: ", sub { dump( $stat ) });
106
107         return 1;
108 }
109
110 =head2 finish
111
112 Close index
113
114  my $affected = $index->finish;
115
116 Returns of records saved in total
117
118 =cut
119
120 sub finish {
121         my $self = shift;
122
123         my $log = $self->_get_logger();
124
125         my $fields = $self->{fields} || confess "no fields?";
126
127         $log->debug("fields = ", sub { dump $fields });
128
129         $log->info("init Jifty");
130         my $path = $self->path || confess "no path?";
131         my $webpac_dir = getcwd();
132         chdir $path || $log->logdie("can't chdir($path) $!");
133         Jifty->new();
134
135         my $affected = 0;
136
137         foreach my $type ( $self->consume_outputs ) {
138                 next unless defined $fields->{$type};
139                 $affected += $self->_sync_field(
140                         $self->database, $type, $fields->{$type}
141                 );
142         }
143
144
145
146         my $glue_path = "$path/lib/Webpacus/Webpac.pm";
147
148         $log->debug("creating clue class Webpacus::Webpac at $glue_path");
149
150         my $glue = <<"_END_OF_GLUE_";
151 package Webpacus::Webpac;
152
153 =head1 NAME
154
155 Webpacus::Webpac - configuration exported from WebPAC
156
157 =cut
158
159 use strict;
160 use warnings;
161
162 sub index_path { '/data/webpac2/var/kinosearch/' };
163
164 1;
165 _END_OF_GLUE_
166
167         $log->debug("glue source:\n$glue");
168
169         write_file( $glue_path, $glue ) || $log->logdie("can't create $glue_path: $!");
170
171         return $affected;
172 };
173
174 sub _sync_field {
175         my $self = shift;
176
177         my ( $database, $type, $field_hash ) = @_;
178
179         my $path = $self->path || confess "no path?";
180
181         my $log = $self->_get_logger();
182
183         my $model = 'Webpacus::Model::' . ucfirst($type);
184         $log->info("sync $model");
185
186         $log->debug("field_hash = ",sub { dump($field_hash) });
187
188         my @field_names = keys %$field_hash;
189
190         if ( ! @field_names ) {
191                 $log->warn("normalization rules don't produce any data for search!");
192                 return;
193         }
194
195         $log->info("syncing $database $type fields: ", join(", ", @field_names));
196
197         my $system_user = Webpacus::CurrentUser->superuser;
198         my $o = $model->new(current_user => $system_user);
199
200         my ( $count, $new, $updated ) = ( 0, 0, 0 );
201
202         foreach my $field ( @field_names ) {
203                 my $items = $field_hash->{$field} || confess "no field?";
204
205                 my ( $id, $msg ) = $o->load_by_cols(
206                         name => $field,
207                         from_database => $database,
208                 );
209
210                 if ( $id ) {
211                         $o->set_items( $items );
212                         $log->debug("updated $database $type field: $field [$items] ID: $id $msg");
213                         $updated++;
214                 } else {
215                         $log->debug("adding $database $type field: $field [$items] $msg");
216                         $o->create(
217                                 name => $field,
218                                 from_database => $database,
219                                 items => $items,
220                         );
221                         $new++;
222                 }
223
224                 $count++;
225         }
226
227         $log->info("synced $count fields (",join(", ", @field_names),") from $database with Webpacus ($new new/$updated updated) at $path");
228
229         return $count;
230
231 }
232
233 =head2 consume_outputs
234
235 Returns array with names of supported output types for this module
236
237 =cut
238
239 sub consume_outputs {
240         return qw/search sorted/;
241 }
242
243 =head1 AUTHOR
244
245 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
246
247 =head1 COPYRIGHT & LICENSE
248
249 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
250
251 This program is free software; you can redistribute it and/or modify it
252 under the same terms as Perl itself.
253
254 =cut
255
256 1;