1package CPAN::SQLite::META;
2require CPAN::SQLite;
3use strict;
4use warnings;
5use base qw(Exporter);
6our @EXPORT_OK;
7@EXPORT_OK = qw(setup update);
8our $global_id;
9our $VERSION = '0.199';
10
11sub new {
12  my ($class, $cpan_meta) = @_;
13  my $cpan_sqlite = CPAN::SQLite->new();
14  bless {cpan_meta => $cpan_meta, cpan_sqlite => $cpan_sqlite}, $class;
15}
16
17sub set {
18  my ($self, $class, $id) = @_;
19  my $sqlite_obj = $self->make_obj(class => $class, id => $id);
20  return $sqlite_obj->set_one();
21}
22
23sub search {
24  my ($self, $class, $regex) = @_;
25  my $sqlite_obj = $self->make_obj(class => $class, regex => $regex);
26  $sqlite_obj->set_many();
27}
28
29sub make_obj {
30  my ($self, %args)  = @_;
31  my $class = $args{class};
32  die qq{Must supply a CPAN::* class string}
33    unless ($class and $class =~ /^CPAN::/);
34  (my $type = $class) =~ s/^CPAN//;
35  my $package = __PACKAGE__ . $type;
36  bless {cpan_meta => $self->{cpan_meta},
37	cpan_sqlite => $self->{cpan_sqlite},
38	class => $class,
39	id => $args{id}, regex => $args{regex},
40	}, $package;
41}
42
43package CPAN::SQLite::META::Author;
44use base qw(CPAN::SQLite::META);
45use CPAN::SQLite::Util qw(has_hash_data);
46
47sub set_one {
48  my $self = shift;
49  my $cpan_sqlite = $self->{cpan_sqlite};
50  my $id = $self->{id};
51  my $class = $self->{class};
52  $cpan_sqlite->{results} = {};
53  $cpan_sqlite->query(mode => 'author', name => $id, meta_obj => $self);
54  my $cpan_meta = $self->{cpan_meta};
55  $cpan_meta->{readonly}{$class}{$id};
56}
57
58sub set_many {
59  my $self = shift;
60  my $cpan_sqlite = $self->{cpan_sqlite};
61  my $regex = $self->{regex};
62  $cpan_sqlite->{results} = [];
63  $cpan_sqlite->query(mode => 'author', query => $regex, meta_obj => $self);
64}
65
66sub set_data {
67  my ($self, $results) = @_;
68  $self->set_author($results->{cpanid}, $results);
69}
70
71package CPAN::SQLite::META::Distribution;
72use base qw(CPAN::SQLite::META);
73use CPAN::SQLite::Util qw(has_hash_data download);
74use CPAN::DistnameInfo;
75my $ext = qr{\.(tar\.gz|tar\.Z|tgz|zip)$};
76
77sub set_one {
78  my $self = shift;
79  my $cpan_sqlite = $self->{cpan_sqlite};
80  my $id = $self->{id};
81  my ($dist_name, $dist_id);
82  if ($id =~ /$ext/) {
83    ($dist_name, $dist_id) = $self->extract_distinfo($id);
84  }
85  return unless ($dist_name and $dist_id);
86  my $class = $self->{class};
87  $cpan_sqlite->{results} = {};
88  $cpan_sqlite->query(mode => 'dist', name => $dist_name, meta_obj => $self);
89  my $cpan_meta = $self->{cpan_meta};
90  $cpan_meta->{readonly}{$class}{$dist_id};
91}
92
93sub set_many {
94  my $self = shift;
95  my $cpan_sqlite = $self->{cpan_sqlite};
96  my $regex = $self->{regex};
97  $cpan_sqlite->{results} = [];
98  $cpan_sqlite->query(mode => 'dist', query => $regex, meta_obj => $self);
99}
100
101sub set_data {
102  my ($self, $results) = @_;
103  $global_id = $results->{download};
104  $self->set_dist($results->{download}, $results);
105}
106
107sub set_list_data {
108  my ($self, $results, $download) = @_;
109  $global_id = $download;
110  $self->set_containsmods($results);
111  $global_id = undef;
112}
113
114package CPAN::SQLite::META::Module;
115use base qw(CPAN::SQLite::META);
116use CPAN::SQLite::Util qw(has_hash_data);
117
118sub set_one {
119  my $self = shift;
120  my $cpan_sqlite = $self->{cpan_sqlite};
121  my $id = $self->{id};
122  return if ($id =~ /^Bundle::/);
123  my $class = $self->{class};
124  $cpan_sqlite->{results} = {};
125  $cpan_sqlite->query(mode => 'module', name => $id, meta_obj => $self);
126  my $cpan_meta = $self->{cpan_meta};
127  $cpan_meta->{readonly}{$class}{$id};
128}
129
130sub set_many {
131  my $self = shift;
132  my $cpan_sqlite = $self->{cpan_sqlite};
133  my $regex = $self->{regex};
134  $cpan_sqlite->{results} = [];
135  $cpan_sqlite->query(mode => 'module', query => $regex, meta_obj => $self);
136}
137
138sub set_data {
139  my ($self, $results) = @_;
140  $self->set_module($results->{mod_name}, $results);
141  $global_id = $results->{download};
142  $self->set_dist($results->{download}, $results);
143}
144
145sub set_list_data {
146  my ($self, $results, $download) = @_;
147  $global_id = $download;
148  $self->set_containsmods($results);
149  $global_id = undef;
150}
151
152package CPAN::SQLite::META::Bundle;
153use base qw(CPAN::SQLite::META);
154use CPAN::SQLite::Util qw(has_hash_data);
155
156sub set_one {
157  my $self = shift;
158  my $cpan_sqlite = $self->{cpan_sqlite};
159  my $id = $self->{id};
160  unless ($id =~ /^Bundle::/) {
161    $id = 'Bundle::' . $id;
162  }
163  my $class = $self->{class};
164  $cpan_sqlite->{results} = {};
165  $cpan_sqlite->query(mode => 'module', name => $id, meta_obj => $self);
166  my $cpan_meta = $self->{cpan_meta};
167  $cpan_meta->{readonly}{$class}{$id};
168}
169
170sub set_many {
171  my $self = shift;
172  my $cpan_sqlite = $self->{cpan_sqlite};
173  my $regex = $self->{regex};
174  unless ($regex =~ /(^Bundle::|[\^\$\*\+\?\|])/i) {
175    $regex = '^Bundle::' . $regex;
176  }
177  $regex = '^Bundle::' if $regex eq '^';
178  $cpan_sqlite->{results} = [];
179  $cpan_sqlite->query(mode => 'module', query => $regex, meta_obj => $self);
180}
181
182sub set_data {
183  my ($self, $results) = @_;
184  $self->set_bundle($results->{mod_name}, $results);
185  $global_id = $results->{download};
186  $self->set_dist($results->{download}, $results);
187}
188
189sub set_list_data {
190  my ($self, $results, $download) = @_;
191  $global_id = $download;
192  $self->set_containsmods($results);
193  $global_id = undef;
194}
195
196package CPAN::SQLite::META;
197use CPAN::SQLite::Util qw(download);
198
199my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
200my @days = qw(Sun Mon Tue Wed Thu Fri Sat);
201
202sub set_author {
203  my ($self, $id, $results) = @_;
204  my $class = 'CPAN::Author';
205  my $cpan_meta = $self->{cpan_meta};
206  $cpan_meta->instance(
207		       $class => $id
208		      )->set(
209			     'FULLNAME' => $results->{fullname},
210			     'EMAIL' => $results->{email},
211			    );
212}
213
214sub set_module {
215  my ($self, $id, $results) = @_;
216  my $class = 'CPAN::Module';
217  my $cpan_meta = $self->{cpan_meta};
218  my %dslip;
219  if (my $dslip = $results->{dslip}) {
220    my @values = split '', $dslip;
221    for (qw(d s l i p)) {
222      $dslip{'stat' . $_} = shift @values;
223    }
224  }
225  my $d = $cpan_meta->instance(
226			       $class => $id
227			      );
228  $d->set(
229	  'description' => $results->{mod_abs},
230	  'userid' => $results->{cpanid},
231	  'CPAN_VERSION' => $results->{mod_vers},
232	  'CPAN_FILE' => $results->{download},
233	  'CPAN_USERID' => $results->{cpanid},
234	  'chapterid' => $results->{chapterid},
235	  %dslip,
236	 );
237}
238
239sub set_bundle {
240  my ($self, $id, $results) = @_;
241  my $class = 'CPAN::Bundle';
242  my $cpan_meta = $self->{cpan_meta};
243  my %dslip;
244  if (my $dslip = $results->{dslip}) {
245    my @values = split '', $dslip;
246    for (qw(d s l i p)) {
247      $dslip{'stat' . $_} = shift @values;
248    }
249  }
250  my $d = $cpan_meta->instance(
251			       $class => $id
252			      );
253  $d->set(
254	  'description' => $results->{mod_abs},
255	  'userid' => $results->{cpanid},
256	  'CPAN_VERSION' => $results->{mod_vers},
257	  'CPAN_FILE' => $results->{download},
258	  'CPAN_USERID' => $results->{cpanid},
259	  'chapterid' => $results->{chapterid},
260	  %dslip,
261	 );
262}
263
264sub set_dist {
265  my ($self, $id, $results) = @_;
266  my $class = 'CPAN::Distribution';
267  my $cpan_meta = $self->{cpan_meta};
268  my $d = $cpan_meta->instance(
269			       $class => $id
270			      );
271  $d->set(
272	  'DESCRIPTION' => $results->{dist_abs},
273	  'CPAN_USERID' => $results->{cpanid},
274	  'CPAN_VERSION' => $results->{dist_vers},
275	 );
276}
277
278sub set_containsmods {
279  my ($self, $mods) = @_;
280  my $class = 'CPAN::Distribution';
281  my $cpan_meta = $self->{cpan_meta};
282  my %containsmods;
283  if ($mods and (ref($mods) eq 'ARRAY')) {
284    %containsmods = map {$_->{mod_name} => 1} @$mods;
285  }
286  my $d = $cpan_meta->instance(
287			       $class => $global_id
288			      );
289  $d->{CONTAINSMODS} =  \%containsmods;
290}
291
292sub reload {
293  my($self, %args) = @_;
294  my $time = $args{'time'} || time;
295  my $force = $args{force};
296  my $db_name = $CPAN::SQLite::db_name;
297  my $db = File::Spec->catfile($CPAN::Config->{cpan_home}, $db_name);
298  my $journal_file = $db . '-journal';
299  if (-e $journal_file) {
300    warn qq{Database locked - cannot update.};
301    return;
302  }
303  my @args = ($^X, '-MCPAN::SQLite::META=setup,update', '-e');
304  if (-e $db && -s _) {
305    my $mtime_db = (stat(_))[9];
306    my $time_string = gmtime_string($mtime_db);
307    warn "Database was generated on $time_string\n";
308    unless ($force) {
309      return if (($time - $mtime_db) < $CPAN::Config->{index_expire}*86400);
310    }
311    warn "Updating database file ...\n";
312    push @args, q{update};
313  }
314  else {
315    unlink($db) if -e _;
316    warn "Creating database file ...\n";
317    push @args, q{setup};
318  }
319  if ($CPAN::SQLite::DBI::dbh) {
320    $CPAN::SQLite::DBI::dbh->disconnect();
321    $CPAN::SQLite::DBI::dbh = undef;
322  }
323  system(@args) == 0 or die qq{system @args failed: $?};
324  warn "Done!\n";
325}
326
327sub setup {
328  my $obj = CPAN::SQLite->new(setup => 1);
329  $obj->index() or die qq{CPAN::SQLite setup failed};
330}
331
332sub update {
333  my $obj = CPAN::SQLite->new();
334  $obj->index() or die qq{CPAN::SQLite update failed};
335}
336
337sub gmtime_string {
338  my $time = shift;
339  return unless $time;
340  my @a = gmtime($time);
341  my $string = sprintf("%s, %02d %s %d %02d:%02d:%02d GMT",
342		      $days[$a[6]], $a[3], $months[$a[4]],
343		      $a[5] + 1900, $a[2], $a[1], $a[0]);
344  return $string;
345}
346
347sub extract_distinfo {
348  my ($self, $pathname) = @_;
349  unless ($pathname =~ m{^\w/\w\w/}) {
350    $pathname =~ s{^(\w)(\w)(.*)}{$1/$1$2/$1$2$3};
351  }
352  my $d = CPAN::DistnameInfo->new($pathname);
353  my $dist = $d->dist;
354  my $download = download($d->cpanid, $d->filename);
355  return ($dist and $download) ? ($dist, $download) : undef;
356}
357
3581;
359
360__END__
361
362=head1 NAME
363
364CPAN::SQLite::META - helper module for CPAN.pm integration
365
366=head1 DESCRIPTION
367
368This module has no direct public interface, but is intended
369as a helper module for use of CPAN::SQLite within the CPAN.pm
370module. A new object is created as
371
372  my $obj = CPAN::SQLite::META->new($CPAN::META);
373
374where C<$CPAN::META> comes from CPAN.pm. There are then
375two main methods available.
376
377=over 4
378
379=item C<set>
380
381This is used as
382
383   $obj->set($class, $id);
384
385where C<$class> is one of C<CPAN::Author>, C<CPAN::Module>, or
386C<CPAN::Distribution>, and C<$id> is the id CPAN.pm uses to
387identify the class. The method searches the C<CPAN::SQLite>
388database by name using the appropriate C<author>, C<dist>,
389or C<module> mode, and if a result is found, calls
390
391    $CPAN::META->instance(
392		         $class => $id
393		         )->set(
394                          %attributes
395		         );
396
397to register an instance of this class within C<CPAN.pm>.
398
399=item C<ssearch>
400
401This is used as
402
403   $obj->search($class, $id);
404
405where C<$class> is one of C<CPAN::Author>, C<CPAN::Module>, or
406C<CPAN::Distribution>, and C<$id> is the id CPAN.pm uses to
407identify the class. The method searches the C<CPAN::SQLite>
408database by C<query> using the appropriate C<author>, C<dist>,
409or C<module> mode, and if results are found, calls
410
411    $CPAN::META->instance(
412		         $class => $id
413		         )->set(
414                          %attributes
415		         );
416
417for each match to register an instance of this class
418within C<CPAN.pm>.
419
420=back
421
422The attributes set within C<$CPAN::META->instance> depend
423on the particular class.
424
425=over
426
427=item author
428
429The attributes are
430
431       'FULLNAME' => $results->{fullname},
432       'EMAIL' => $results->{email},
433
434where C<$results> are the results returned from C<CPAN::SQLite>.
435
436=item module
437
438The attributes are
439
440	'description' => $results->{mod_abs},
441	'userid' => $results->{cpanid},
442	'CPAN_VERSION' => $results->{mod_vers},
443	'CPAN_FILE' => $results->{download},
444	'CPAN_USERID' => $results->{cpanid},
445	'chapterid' => $results->{chapterid},
446	%dslip,
447
448where C<$results> are the results returned from C<CPAN::SQLite>.
449Here, C<%dslip> is a hash containing keys C<statd>, C<stats>,
450C<statl>, C<stati>, and C<statp>, with corresponding values
451being the registered dslip entries for the module, if present.
452
453=item dist
454
455The attributes are
456
457       'DESCRIPTION' => $results->{dist_abs},
458       'CPAN_USERID' => $results->{cpanid},
459       'CPAN_VERSION' => $results->{dist_vers},
460
461As well, a C<CONTAINSMODS> key to C<$CPAN::META> is added, this
462being a hash reference whose keys are the modules contained
463within the distribution.
464
465=back
466
467There is also a method available C<reload>, which rebuilds
468the database. It can be used as
469
470   $obj->reload(force => 1, time => $time);
471
472The C<time> option (which, if not passed in, will default to the
473current time) will be used to compare the current time to
474the mtime of the database file; if they differ by more than
475one day, the database will be rebuilt. The <force> option, if
476given, will force a rebuilding of the database regardless
477of the time difference.
478
479=cut
480
481