<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Debian::WNPP::Query;
use strict;
use warnings;

our $VERSION = '0.74';

=head1 NAME

Debian::WNPP::Query - offline storage of Debian's work-needing package lists

=head1 SYNOPSIS

    my $wnpp = Debian::WNPP::Query-&gt;new(
        {   cache_dir       =&gt; '/somewhere',
            network_enabled =&gt; 0,
            ttl             =&gt; 3600 * 24,
            bug_types       =&gt; [qw( ITP RFP )]
        }
    );

    my @bugs = $wnpp-&gt;bugs_for_package('ken-lee');

=head1 DESCRIPTION

Debian::WNPP::Query provides a way to retrieve and cache the contents of
Debian's "Work-needing and prospective packages" lists.

=head1 CONSTRUCTOR

B&lt;new&gt; is the constructor. Initial field values are to be given as a hash
reference.

If B&lt;cache_file&gt; is given, it is read.

=cut

use base 'Class::Accessor';

__PACKAGE__-&gt;mk_accessors(
    qw(
        cache_file ttl bug_types
        _bug_types _cache
        )
);

use autodie;
use Debian::WNPP::Bug;
use File::Basename qw(dirname);
use File::Path;
use Storable ();
use WWW::Mechanize ();

our %list_url = (
    ITP =&gt; 'http://www.debian.org/devel/wnpp/being_packaged',
    RFP =&gt; 'http://www.debian.org/devel/wnpp/requested',
    ITA =&gt; 'http://www.debian.org/devel/wnpp/being_adopted',
    RFA =&gt; 'http://www.debian.org/devel/wnpp/rfa_bypackage',
    O   =&gt; 'http://www.debian.org/devel/wnpp/orphaned',
);

sub new {
    my $class = shift;
    my $self = $class-&gt;SUPER::new(@_);

    # default to all types
    $self-&gt;_bug_types(
        { map( ( $_ =&gt; 1 ), @{ $self-&gt;bug_types || [ keys %list_url ] } ), }
    );

    # default TTL
    $self-&gt;ttl( 24 * 3600 )
        unless defined $self-&gt;ttl;

    $self-&gt;_cache( {} );

    $self-&gt;_read_cache if $self-&gt;cache_file;
    $self-&gt;_fetch
        if not $self-&gt;_cache-&gt;{timestamp}
            or ( ( time - $self-&gt;_cache-&gt;{timestamp} ) &gt; $self-&gt;ttl );

    return $self;
}

sub _read_cache {
    my $self = shift;

    return unless $self-&gt;cache_file and -e $self-&gt;cache_file;

    $self-&gt;_cache( eval { Storable::retrieve( $self-&gt;cache_file ) }
            || {} );
}

sub _write_cache {
    my $self = shift;

    return unless $self-&gt;cache_file;

    File::Path::make_path( dirname( $self-&gt;cache_file ) );

    $self-&gt;_cache-&gt;{timestamp} = scalar(time);

    Storable::nstore( $self-&gt;_cache, $self-&gt;cache_file );
}

sub _fetch {
    my $self = shift;

    my $browser = WWW::Mechanize-&gt;new();

    while( my( $type, $url ) = each %list_url ) {
        eval {
            $browser-&gt;get($url);
        };
        if ($@) {
            warn "Error retrieving the list of $type bugs:\n";
            warn $@;
            next;
        }

        for my $link ( $browser-&gt;links ) {
            next unless $link-&gt;url =~ m{^http://bugs.debian.org/(\d+)};

            my $bug = $1;

            my $desc = $link-&gt;text;
            $desc =~ s/^([^:]+): //;
            my $package = $1;

            push @{ $self-&gt;_cache-&gt;{$package} ||= [] },
                Debian::WNPP::Bug-&gt;new(
                {   type              =&gt; $type,
                    number            =&gt; $bug,
                    package           =&gt; $package,
                    short_description =&gt; $desc,
                    title             =&gt; "$type: $package -- $desc",
                }
                );
        }
    }

    $self-&gt;_write_cache;
}

=head1 FIELDS

=over

=item cache_file I&lt;path&gt;

The path to the file holding the offline cache of the WNPP lists. If not
specified, no cache is read or written.

=item ttl I&lt;seconds&gt;

The time after which the on-disk cache is considered too old and WNPP pages are
retrieved afresh. Ignored if B&lt;cache_file&gt; is not defined. Defaults to 86400 (1
day).

=item bug_types I&lt;arrayref&gt;

Specified which bug types to retrieve. For example, if you are interested in
ITP and RFP bugs, there is no point in downloading, parsing and storing
ITA/RFA/O bugs. By default all types of bugs are processed.

=back

=head1 METHODS

=over

=item bugs_for_package(I&lt;package&gt;)

Returns a list of bugs matching the given package name. Normally the list would
contain only one bug, but there are no guarantees.

=cut

sub bugs_for_package {
    my ( $self, $package ) = @_;

    if (exists $self-&gt;_cache-&gt;{ $package }) {
        return @{ $self-&gt;_cache-&gt;{ $package } };
    }
    return ();
}

=back

=head1 SEE ALSO

=over

=item L&lt;Debian::WNPP::Bug&gt;

=item L&lt;http://www.debian.org/devel/wnpp/&gt;

=back

=head1 AUTHOR AND COPYRIGHT

=over

=item Copyright (C) 2010 Damyan Ivanov &lt;dmn@debian.org&gt;

=back

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License version 2 as published by the Free
Software Foundation.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
Street, Fifth Floor, Boston, MA 02110-1301 USA.

=cut

1;
</pre></body></html>