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

        return 1;
}


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