AnnoCPAN::Update - Update AnnoCPAN database from local CPAN mirror

AnnoCPAN documentation Contained in the AnnoCPAN distribution.

Index

Code Index:

NAME

Top

AnnoCPAN::Update - Update AnnoCPAN database from local CPAN mirror

SYNOPSYS

Top

    use AnnoCPAN::Config 'config.pl';
    use AnnoCPAN::Update;
    AnnoCPAN::Update->run(verbose => 1);

DESCRIPTION

Top

This module is used for updating an annocpan database from a local CPAN mirror.

METHODS

Top

new

Construct an AnnoCPAN::Update object. Options

cpan_root

The directory containing the local CPAN mirror.

dist_class

The name of the class used to construct CPAN distribution objects. Defaults to AnnoCPAN::Dist.

run

Does everything: loads the new modules, deletes the modules that no longer exist, and collects the garbage.

If called as a class method, it calls the constructor automatically.

load_db

Load the new modules into the database. Modules that are already loaded are not affected.

load_dist($fname)

Load a specific distribution. If it is already in the database, does nothing.

delete_missing

Delete from the database all the distributions that no longer exist in the CPAN mirror.

garbage_collect

Delete from the database the Pods and Dists that no longer exist in any version.

SEE ALSO

Top

AnnoCPAN::DBI, AnnoCPAN::Config, AnnoCPAN::Dist

AUTHOR

Top

Ivan Tubert-Brohman <itub@cpan.org>

COPYRIGHT

Top

Copyright (c) 2005 Ivan Tubert-Brohman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

AnnoCPAN documentation Contained in the AnnoCPAN distribution. 
package AnnoCPAN::Update;

$VERSION = '0.22';

use strict;
use warnings;


use File::Find qw(find);
use AnnoCPAN::Config;
use AnnoCPAN::Dist qw(:all);


sub new {
    my ($class, %opts) = @_;
    bless \%opts, $class;
    $opts{cpan_root} ||= AnnoCPAN::Config->option('cpan_root');
    $opts{path} = $opts{cpan_root};
    $opts{path} .= '/authors/id' unless $opts{path} =~ m|/authors/id|;
    $opts{cpan_root} =~ s|/authors/id.*||;
    $opts{dist_class} = $opts{dist_class}
        || AnnoCPAN::Config->option('dist_class')
        || 'AnnoCPAN::Dist';
    \%opts;
}


sub run {
    my $self = shift;
    return $self->new(@_)->run unless ref $self;
    $self->log('Beginning update');
    $self->load_db;
    $self->log('Deleting missing distvers');
    $self->delete_missing;
    $self->log('Collecting garbage');
    $self->garbage_collect;
    $self->log('Done');
}



sub load_db {
    my ($self) = @_;

    my $it = AnnoCPAN::DBI::DistVer->retrieve_all;
    my %seen;
    while (my $dv = $it->next) {
        $seen{$dv->path}++;
    }
    $self->{seen} = \%seen;

    find(
        {wanted => sub { $self->load_dist($_) }, no_chdir => 1 }, 
        $self->{path},
    );
}


sub load_dist {
    my ($self, $fname) = @_;

    return unless $fname =~ m{(authors/id/.*(\.tar\.gz|\.tgz|\.zip))$};
    return if $self->{seen}{$1};

    $self->log($fname);
    if (my $dist = $self->{dist_class}->new(
        $fname, verbose => $self->verbose)) 
    {
        my ($distver, $status) = $dist->extract;
        if ($distver and $status == DIST_ADDED and not $self->{new}) {
            # this is a new dist; check if notes have to be propagated
            $distver->translate_notes;
        }
    }
}


sub delete_missing {
    my ($self) = @_;
    my $it = AnnoCPAN::DBI::DistVer->retrieve_all;
    my $cpan = $self->{cpan_root};
    while (my $distver = $it->next) {
        my $path = $distver->path;
        #print "checking $path\n";
        unless (-e "$cpan/$path") {
            $self->log("deleting entry for $path from database");
            $distver->delete;
        }
    }
}


sub garbage_collect {
    my ($self) = @_;
    AnnoCPAN::DBI::Pod->garbage_collect;
    AnnoCPAN::DBI::Dist->garbage_collect;
}

sub verbose     { shift->{verbose} }

sub log {
    my ($self, $message) = @_;
    printf "%s\t%s\n", scalar localtime, $message if $self->verbose;
}


1;