/[webpac2]/trunk/lib/WebPAC/Output/Sorted.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/lib/WebPAC/Output/Sorted.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 920 - (show annotations)
Tue Oct 30 22:46:51 2007 UTC (16 years, 6 months ago) by dpavlin
File size: 2851 byte(s)
 r1386@llin:  dpavlin | 2007-10-30 23:46:53 +0100
 new WebPAC::Output::Sorted to create huge sorted lists using
 Sort::External (to keep memory under controll)

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;

  ViewVC Help
Powered by ViewVC 1.1.26