WebPAC/Output/Webpacus.pm

package WebPAC::Output::Webpacus;

use warnings;
use strict;

use base qw/WebPAC::Common WebPAC::Output Class::Accessor/;
__PACKAGE__->mk_accessors(qw(
        path
        database
        input
));

use File::Path;
use Data::Dump qw/dump/;
use WebPAC::Common qw/force_array/;
use Carp qw/confess/;
use Cwd;
use File::Slurp;

use Jifty;

=head1 NAME

WebPAC::Output::Webpacus - integrate WebPAC front-end with Jifty back-end

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SYNOPSIS

Does black magic to sync data between WebPAC and Webpacus, web front-end
implement in Jifty

=head1 FUNCTIONS

=head2 new

 my $output = new WebPAC::Output::Webpacus({
        path => '/path/to/Webpacus',
        database => 'demo',
 });

=head2 init

 $output->init;

=cut

sub init {
        my $self = shift;

        my $log = $self->_get_logger;

        foreach my $p (qw/path database/) {
                $log->logdie("need $p") unless ($self->$p);
        }

        my $path = $self->path;

        $log->logdie("Webpacus path $path not found: $!") unless -d $path;

        my $config_path = "$path/etc/config.yml";

        $log->logdie("expected Webpacus config at $config_path: $!") unless -e $config_path;

        $self->{fields} = {};

}


=head2 add

Adds one entry

  $est->add( 42, $ds );

=cut

sub add {
        my $self = shift;

        my ( $id, $ds ) = @_;

        my $log = $self->_get_logger;
        $log->logdie("need id") unless defined $id;
        $log->logdie("need ds") unless $ds;

        $log->debug("id: $id ds = ",sub { dump($ds) });

        my $hash = $self->ds_to_hash( $ds, 'sorted' ) || return;

        foreach my $f ( keys %$hash ) {
                $self->{fields}->{$f}++;
        }

        return 1;
}

=head2 finish

Close index

 $index->finish;

=cut

sub finish {
        my $self = shift;

        my $log = $self->_get_logger();

        $log->info("syncing search fields");

        my $fields = $self->{fields} || confess "no fields?";
        my $path = $self->path || confess "no path?";

        $log->debug("fields = ", sub { dump $fields });

        my $webpac_dir = getcwd();

        chdir $path || $log->logdie("can't chdir($path) $!");

#       push @INC, $path;
        Jifty->new();
        my $system_user = Webpacus::CurrentUser->superuser;
        my $o = Webpacus::Model::Search->new(current_user => $system_user);

        my ( $count, $new, $updated ) = ( 0, 0, 0 );

        foreach my $field ( keys %$fields ) {
                my $items = $fields->{$field} || confess "no field?";

                my ( $id, $msg ) = $o->load_by_cols( name => $field );

                if ( $id ) {
                        $o->set_items( $items );
                        $log->debug("updated search field: $field [$items] ID: $id $msg");
                        $updated++;
                } else {
                        $log->debug("adding search field: $field [$items] $msg");
                        $o->create(
                                name => $field,
                                items => $items,
                        );
                        $new++;
                }

                $count++;
        }

        $log->info("synced $count search fields with Webpacus ($new new/$updated updated) at $path");

        my $glue_path = "$path/lib/Webpacus/Webpac.pm";

        $log->debug("creating clue class Webpacus::Webpac at $glue_path");

        my $glue = <<"_END_OF_GLUE_";
package Webpacus::Webpac;

=head1 NAME

Webpacus::Webpac - configuration exported from WebPAC

=cut

use strict;
use warnings;

sub index_path { '/data/webpac2/var/kinosearch/webpacus' };

1;
_END_OF_GLUE_

        $log->debug("glue source:\n$glue");

        write_file( $glue_path, $glue ) || $log->logdie("can't create $glue_path: $!");

        return $count;

}


=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;
1	dpavlin	932	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	dpavlin	936	input
11	dpavlin	932	));
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	dpavlin	933	use File::Slurp;
19	dpavlin	932
20			use Jifty;
21
22			=head1 NAME
23
24			WebPAC::Output::Webpacus - integrate WebPAC front-end with Jifty back-end
25
26			=head1 VERSION
27
28			Version 0.01
29
30			=cut
31
32			our $VERSION = '0.01';
33
34			=head1 SYNOPSIS
35
36			Does black magic to sync data between WebPAC and Webpacus, web front-end
37			implement in Jifty
38
39			=head1 FUNCTIONS
40
41			=head2 new
42
43			my $output = new WebPAC::Output::Webpacus({
44			path => '/path/to/Webpacus',
45			database => 'demo',
46			});
47
48			=head2 init
49
50			$output->init;
51
52			=cut
53
54			sub init {
55			my $self = shift;
56
57			my $log = $self->_get_logger;
58
59			foreach my $p (qw/path database/) {
60			$log->logdie("need $p") unless ($self->$p);
61			}
62
63			my $path = $self->path;
64
65			$log->logdie("Webpacus path $path not found: $!") unless -d $path;
66
67			my $config_path = "$path/etc/config.yml";
68
69			$log->logdie("expected Webpacus config at $config_path: $!") unless -e $config_path;
70
71			$self->{fields} = {};
72
73			}
74
75
76			=head2 add
77
78			Adds one entry
79
80			$est->add( 42, $ds );
81
82			=cut
83
84			sub add {
85			my $self = shift;
86
87			my ( $id, $ds ) = @_;
88
89			my $log = $self->_get_logger;
90			$log->logdie("need id") unless defined $id;
91			$log->logdie("need ds") unless $ds;
92
93			$log->debug("id: $id ds = ",sub { dump($ds) });
94
95			my $hash = $self->ds_to_hash( $ds, 'sorted' ) \|\| return;
96
97			foreach my $f ( keys %$hash ) {
98			$self->{fields}->{$f}++;
99			}
100
101			return 1;
102			}
103
104			=head2 finish
105
106			Close index
107
108			$index->finish;
109
110			=cut
111
112			sub finish {
113			my $self = shift;
114
115			my $log = $self->_get_logger();
116
117			$log->info("syncing search fields");
118
119			my $fields = $self->{fields} \|\| confess "no fields?";
120			my $path = $self->path \|\| confess "no path?";
121
122			$log->debug("fields = ", sub { dump $fields });
123
124			my $webpac_dir = getcwd();
125
126			chdir $path \|\| $log->logdie("can't chdir($path) $!");
127
128			# push @INC, $path;
129			Jifty->new();
130			my $system_user = Webpacus::CurrentUser->superuser;
131			my $o = Webpacus::Model::Search->new(current_user => $system_user);
132
133	dpavlin	951	my ( $count, $new, $updated ) = ( 0, 0, 0 );
134	dpavlin	932
135			foreach my $field ( keys %$fields ) {
136	dpavlin	933	my $items = $fields->{$field} \|\| confess "no field?";
137	dpavlin	951
138			my ( $id, $msg ) = $o->load_by_cols( name => $field );
139
140			if ( $id ) {
141			$o->set_items( $items );
142			$log->debug("updated search field: $field [$items] ID: $id $msg");
143			$updated++;
144			} else {
145			$log->debug("adding search field: $field [$items] $msg");
146			$o->create(
147			name => $field,
148			items => $items,
149			);
150			$new++;
151			}
152
153	dpavlin	932	$count++;
154			}
155
156	dpavlin	951	$log->info("synced $count search fields with Webpacus ($new new/$updated updated) at $path");
157	dpavlin	933
158			my $glue_path = "$path/lib/Webpacus/Webpac.pm";
159
160	dpavlin	951	$log->debug("creating clue class Webpacus::Webpac at $glue_path");
161	dpavlin	933
162			my $glue = <<"_END_OF_GLUE_";
163			package Webpacus::Webpac;
164
165			=head1 NAME
166
167			Webpacus::Webpac - configuration exported from WebPAC
168
169			=cut
170
171			use strict;
172			use warnings;
173
174			sub index_path { '/data/webpac2/var/kinosearch/webpacus' };
175
176			1;
177			_END_OF_GLUE_
178
179			$log->debug("glue source:\n$glue");
180
181			write_file( $glue_path, $glue ) \|\| $log->logdie("can't create $glue_path: $!");
182
183	dpavlin	932	return $count;
184
185			}
186
187
188			=head1 AUTHOR
189
190			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
191
192			=head1 COPYRIGHT & LICENSE
193
194			Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
195
196			This program is free software; you can redistribute it and/or modify it
197			under the same terms as Perl itself.
198
199			=cut
200
201			1;