/[webpac2]/trunk/lib/WebPAC/Output/SWISH.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WebPAC/Output/SWISH.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1146 by dpavlin, Thu Apr 23 11:14:24 2009 UTC revision 1147 by dpavlin, Thu Apr 23 13:20:51 2009 UTC
# Line 3  package WebPAC::Output::SWISH; Line 3  package WebPAC::Output::SWISH;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6  use base qw/WebPAC::Common/;  use lib 'lib';
7    
8    use base qw/WebPAC::Common Class::Accessor/;
9    __PACKAGE__->mk_accessors(qw(
10            database
11            type
12    
13            index_path
14    ));
15    
16  use File::Path qw/make_path/;  use File::Path qw/make_path/;
17  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
18  use YAML;  use YAML;
19    
20    
21  =head1 NAME  =head1 NAME
22    
23  WebPAC::Output::SWISH - Create swish-e full text index  WebPAC::Output::SWISH - Create swish-e full text index
# Line 26  type C<search>. Line 35  type C<search>.
35    
36  =head2 new  =head2 new
37    
38   my $out = new WebPAC::Output::SWISH(   my $out = new WebPAC::Output::SWISH({
39          database => 'demo',          database => 'demo',
40   );   });
41    
42  Options are:  Options are:
43    
# Line 46  Name of database will be used to form UR Line 55  Name of database will be used to form UR
55    
56  our $dir = 'var/swish';  our $dir = 'var/swish';
57    
58  sub new {  sub init {
59          my $class = shift;          my $self = shift;
         my $self = {@_};  
         bless($self, $class);  
60    
61          my $log = $self->_get_logger;          my $log = $self->_get_logger;
62    
63          #$log->debug("self: ", sub { dump($self) });          my $database = $self->database || $log->logdie("need database");
64    
65          my $database = $self->{database} || $log->logdie("need database");          make_path $dir if ! -e $dir;
66    
67          my $path = "$dir/$database.conf";          my $path = "$dir/$database.conf";
68    
# Line 80  UndefinedXMLAttributes auto Line 87  UndefinedXMLAttributes auto
87  IndexFile $dir/$database  IndexFile $dir/$database
88    
89  # Croatian ISO-8859-2 characters to unaccented equivalents  # Croatian ISO-8859-2 characters to unaccented equivalents
90  TranslateCharacters ¹©ðÐèÈæƾ® ssddcccczz  #TranslateCharacters ¹©ðÐèÈæƾ® ssddcccczz
91    
92    
93  # disable output  # disable output
# Line 91  DEFAULT_SWISH_CONF Line 98  DEFAULT_SWISH_CONF
98    
99          close($conf) || die "can't write config $path: $!";          close($conf) || die "can't write config $path: $!";
100    
101          $self->{_swish_index_path} = "$dir/$database";          $self->index_path( "$dir/$database" );
102    
103          my $swish = "swish-e -S prog -c $path";          my $swish = "swish-e -S prog -c $path";
104          open( $self->{_swish_fh}, '-|', $swish ) || die "can't open pipe to $swish: $!";          open( $self->{_swish_fh}, '|-', $swish ) || die "can't open pipe to $swish: $!";
105    
106            $log->info( "created $path ", -s $path, " bytes for ", $self->index_path );
107    
108          $self->{stats} = {};          $self->{stats} = {};
109    
# Line 105  DEFAULT_SWISH_CONF Line 114  DEFAULT_SWISH_CONF
114    
115    my $path = $out->index_path;    my $path = $out->index_path;
116    
 =cut  
   
 sub index_path { $_[0]->{_swish_index_path} };  
   
117  =head2 add  =head2 add
118    
119  Adds one entry to database.    $out->add( 42, $ds );
   
   $out->add(  
         id => 42,  
         ds => $ds,  
         type => 'display',  
         text => 'optional text from which snippet is created',  
   );  
   
 This function will create  entries in index using following URI format:  
   
   C<file:///type/database%20name/000>  
   
 Each tag in C<data_structure> with specified C<type> will create one  
 attribute and corresponding hidden text (used for search).  
120    
121  =cut  =cut
122    
# Line 133  my %escape = ('<'=>'&lt;', '>'=>'&gt;', Line 124  my %escape = ('<'=>'&lt;', '>'=>'&gt;',
124  my $escape_re  = join '|' => keys %escape;  my $escape_re  = join '|' => keys %escape;
125    
126  sub add {  sub add {
127          my $self = shift;          my ($self,$id,$ds) = @_;
   
         my $args = {@_};  
128    
129          my $log = $self->_get_logger;          my $log = $self->_get_logger;
130            $log->debug("id: $id ds = ",sub { dump($ds) });
131    
132          my $database = $self->{'database'} || $log->logconfess('no database in $self');          my $database = $self->database || $log->logconfess('no database in $self');
         $log->logconfess('need db in object') unless ($self->{'db'});  
133    
134          foreach my $p (qw/id ds type/) {          my $uri = $self->database . "/$id";
                 $log->logdie("need $p") unless ($args->{$p});  
         }  
   
         my $type = $args->{'type'};  
         my $id = $args->{'id'};  
   
         my $uri = "$database/$id";  
135          $log->debug("creating $uri");          $log->debug("creating $uri");
136    
137          # filter all tags which have type defined          # filter all tags which have type defined
138            my $type = $self->type || 'search';
139          my @tags = grep {          my @tags = grep {
140                  ref($args->{'ds'}->{$_}) eq 'HASH' && defined( $args->{'ds'}->{$_}->{$type} )                  ref($ds->{$_}) eq 'HASH' && defined( $ds->{$_}->{$type} )
141          } keys %{ $args->{'ds'} };          } keys %{ $ds };
142    
143          $log->debug("tags = ", join(",", @tags));          $log->debug("tags = ", join(",", @tags));
144    
# Line 165  sub add { Line 148  sub add {
148    
149          foreach my $tag (@tags) {          foreach my $tag (@tags) {
150    
151                  my $vals = join(" ", @{ $args->{'ds'}->{$tag}->{$type} });                  my $r = ref $ds->{$tag}->{$type};
152                    die "tag $tag type $type not ARRAY but '$r' = ",dump( $ds->{$tag}->{$type} ) unless $r eq 'ARRAY';
153    
154                    my $vals = join(" ", @{ $ds->{$tag}->{$type} });
155    
156                  next if ! $vals;                  next if ! $vals;
157    
# Line 179  sub add { Line 165  sub add {
165    
166          my $len = length($xml);          my $len = length($xml);
167    
168          my $fh = $self->{_swish_fh};          my $fh = $self->{_swish_fh} || die "_swish_fh missing";
169    
170          print $fh "Path-Name: $uri\nContent-Length: $len\nDocument-Type: XML\n\n$xml";          print $fh "Path-Name: $uri\nContent-Length: $len\nDocument-Type: XML\n\n$xml" or
171  #               || die "can't add $uri: $@\n$xml\n";                  die "can't add $uri: $@\n$xml";
172    
173          return 1;          return 1;
174  }  }
# Line 201  sub finish { Line 187  sub finish {
187          YAML::DumpFile( $path, $self->{stats} );          YAML::DumpFile( $path, $self->{stats} );
188          $log->info("created  $path ", -s $path, " bytes");          $log->info("created  $path ", -s $path, " bytes");
189          $log->debug( dump( $self->{stats} ) );          $log->debug( dump( $self->{stats} ) );
190    
191            close( $self->{_swish_fh} ) || die "can't close index ", $self->index_path, ": $!";
192  }  }
193    
194  =head1 AUTHOR  =head1 AUTHOR
Legend:
Removed from v.1146  
changed lines
  Added in v.1147
  ViewVC Help
Powered by ViewVC 1.1.26