WebPAC/Output/Sorted.pm

package WebPAC::Output::Sorted;

use warnings;
use strict;

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

        sortex
));

use Sort::External;
use File::Path;
use Data::Dump qw/dump/;
use WebPAC::Common qw/force_array/;

=head1 NAME

WebPAC::Output::Sorted - create sorted lists

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SYNOPSIS

Create sorted with from data with type C<sorted>.

=head1 FUNCTIONS

=head2 new

 my $output = new WebPAC::Output::Sorted({
        path => '/path/to/sorted_dir',
        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);
        }

        if ( ! -e $self->path ) {
                mkpath $self->path || $log->logdie("can't create ", $self->path,": $!");
                $log->info("created ", $self->path);
        }

        return 1;
}


=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;

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

        foreach my $f ( keys %$hash ) {

                my $sortex = $self->{sortex}->{$f};

                if ( ! $sortex ) {

                        my $sortscheme = sub { $Sort::External::b <=> $Sort::External::a };
                        $sortex = Sort::External->new(
                                -mem_threshold   => 2**24,            # default: 2**20 (1Mb)
                                -cache_size      => 100_000,          # default: undef (disabled) 
#                               -sortsub         => $sortscheme,      # default sort: standard lexical
#                               -working_dir     => $tmp,
                        );

                        $log->logdie("can't create sorted list for $f: $!") unless $sortex;

                        $log->info("created sorted list for $f");

                        $self->{sortex}->{$f} = $sortex;

                };

                my @v;

                # we want LF in output file :-)
                @v = map { "$_\n" } force_array( $hash->{$f} );

                $self->{sortex}->{$f}->feed( @v );

        }

        return 1;
}

=head2 finish

Close index

 $index->finish;

=cut

sub finish {
        my $self = shift;

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

        $log->info("finish sorted lists");

        foreach my $list ( keys %{ $self->{sortex} } ) {

                my $path = $self->path . '/' . $list . '.txt';
                $log->info("saving $list to $path");

                use Fcntl;
                $self->{sortex}->{$list}->finish( 
                        -outfile => $path,
                        -flags => (O_CREAT | O_WRONLY),
                );
        
        }

        $log->info("over with sorted lists");
}


=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	920	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	dpavlin	924	use WebPAC::Common qw/force_array/;
18	dpavlin	920
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	dpavlin	938	return 1;
65	dpavlin	920	}
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	dpavlin	925	$log->debug("id: $id ds = ",sub { dump($ds) });
86	dpavlin	920
87			my $hash = $self->ds_to_hash( $ds, 'sorted' ) \|\| return;
88
89	dpavlin	924	$log->debug("add( $id, ", sub { dump($ds) }," ) => ", sub { dump( $hash ) });
90	dpavlin	920
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 => 224, # default: 220 (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	dpavlin	924	@v = map { "$_\n" } force_array( $hash->{$f} );
117	dpavlin	920
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
156
157			=head1 AUTHOR
158
159			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
160
161			=head1 COPYRIGHT & LICENSE
162
163			Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
164
165			This program is free software; you can redistribute it and/or modify it
166			under the same terms as Perl itself.
167
168			=cut
169
170			1;