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);
        }

}


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