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