git.rot13.org Git - webpac2/blob - lib/WebPAC/Output/Sorted.pm

   1 package WebPAC::Output::Sorted;
   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
  11         sortex
  12 ));
  13
  14 use Sort::External;
  15 use File::Path;
  16 use Data::Dump qw/dump/;
  17
  18 =head1 NAME
  19
  20 WebPAC::Output::Sorted - create sorted lists
  21
  22 =head1 VERSION
  23
  24 Version 0.01
  25
  26 =cut
  27
  28 our $VERSION = '0.01';
  29
  30 =head1 SYNOPSIS
  31
  32 Create sorted with from data with type C<sorted>.
  33
  34 =head1 FUNCTIONS
  35
  36 =head2 new
  37
  38  my $output = new WebPAC::Output::Sorted({
  39         path => '/path/to/sorted_dir',
  40         database => 'demo',
  41  });
  42
  43 =head2 init
  44
  45  $output->init;
  46
  47 =cut
  48
  49 sub init {
  50         my $self = shift;
  51
  52         my $log = $self->_get_logger;
  53
  54         foreach my $p (qw/path database/) {
  55                 $log->logdie("need $p") unless ($self->$p);
  56         }
  57
  58         if ( ! -e $self->path ) {
  59                 mkpath $self->path || $log->logdie("can't create ", $self->path,": $!");
  60                 $log->info("created ", $self->path);
  61         }
  62
  63 }
  64
  65
  66 =head2 add
  67
  68 Adds one entry
  69
  70   $est->add( 42, $ds );
  71
  72 =cut
  73
  74 sub add {
  75         my $self = shift;
  76
  77         my ( $id, $ds ) = @_;
  78
  79         my $log = $self->_get_logger;
  80         $log->logdie("need id") unless defined $id;
  81         $log->logdie("need ds") unless $ds;
  82
  83         $log->debug("id: $id ds = ",dump($ds));
  84
  85         my $hash = $self->ds_to_hash( $ds, 'sorted' ) || return;
  86
  87         warn "add( $id, ",dump($ds)," ) => ", dump( $hash );
  88
  89         foreach my $f ( keys %$hash ) {
  90
  91                 my $sortex = $self->{sortex}->{$f};
  92
  93                 if ( ! $sortex ) {
  94
  95                         my $sortscheme = sub { $Sort::External::b <=> $Sort::External::a };
  96                         $sortex = Sort::External->new(
  97                                 -mem_threshold   => 2**24,            # default: 2**20 (1Mb)
  98                                 -cache_size      => 100_000,          # default: undef (disabled)
  99 #                               -sortsub         => $sortscheme,      # default sort: standard lexical
 100 #                               -working_dir     => $tmp,
 101                         );
 102
 103                         $log->logdie("can't create sorted list for $f: $!") unless $sortex;
 104
 105                         $log->info("created sorted list for $f");
 106
 107                         $self->{sortex}->{$f} = $sortex;
 108
 109                 };
 110
 111                 my @v;
 112
 113                 if ( ref( $hash->{$f} ) eq 'ARRAY' ) {
 114                         @v = @{ $hash->{$f} };
 115                 } else {
 116                         @v =    $hash->{$f}  ;
 117                 }
 118
 119                 # we want LF in output file :-)
 120                 @v = map { "$_\n" } @v;
 121
 122                 $self->{sortex}->{$f}->feed( @v );
 123
 124         }
 125
 126         return 1;
 127 }
 128
 129 =head2 finish
 130
 131 Close index
 132
 133  $index->finish;
 134
 135 =cut
 136
 137 sub finish {
 138         my $self = shift;
 139
 140         my $log = $self->_get_logger();
 141
 142         $log->info("finish sorted lists");
 143
 144         foreach my $list ( keys %{ $self->{sortex} } ) {
 145
 146                 my $path = $self->path . '/' . $list . '.txt';
 147                 $log->info("saving $list to $path");
 148
 149                 use Fcntl;
 150                 $self->{sortex}->{$list}->finish(
 151                         -outfile => $path,
 152                         -flags => (O_CREAT | O_WRONLY),
 153                 );
 154
 155         }
 156
 157         $log->info("over with sorted lists");
 158 }
 159
 160
 161 =head1 AUTHOR
 162
 163 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
 164
 165 =head1 COPYRIGHT & LICENSE
 166
 167 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
 168
 169 This program is free software; you can redistribute it and/or modify it
 170 under the same terms as Perl itself.
 171
 172 =cut
 173
 174 1;