# -*- perl -*-
# Maemian::Collect::Source -- interface to source package data collection

# Copyright (C) 2008 Russ Allbery
# Copyright (C) 2009 Raphael Geissert
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 2 of the License, or (at your option)
# any later version.
#
# 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, see <http://www.gnu.org/licenses/>.

package Maemian::Collect::Source;

use strict;
use warnings;
use base 'Maemian::Collect';

use Maemian::Relation;
use Parse::DebianChangelog;

use Util;

our @ISA = qw(Maemian::Collect);

# Initialize a new source package collect object.  Takes the package name,
# which is currently unused.
sub new {
    my ($class, $pkg) = @_;
    my $self = {};
    bless($self, $class);
    return $self;
}

# Get the changelog file of a source package as a Parse::DebianChangelog
# object.  Returns undef if the changelog file couldn't be found.
# sub changelog Needs-Info <>
sub changelog {
    my ($self) = @_;
    return $self->{changelog} if exists $self->{changelog};
    if (-l 'debfiles/changelog' || ! -f 'debfiles/changelog') {
        $self->{changelog} = undef;
    } else {
        my %opts = (infile => 'debfiles/changelog', quiet => 1);
        $self->{changelog} = Parse::DebianChangelog->init(\%opts);
    }
    return $self->{changelog};
}

# Returns whether the package is a native package.  For everything except
# format 3.0 (quilt) packages, we base this on whether we have a Debian
# *.diff.gz file.  3.0 (quilt) packages are always non-native.  Returns true
# if the package is native and false otherwise.
# sub native Needs-Info <>
sub native {
    my ($self) = @_;
    return $self->{native} if exists $self->{native};
    my $format = $self->field('format');
    if ($format =~ /^\s*2\.0\s*$/ or $format =~ /^\s*3\.0\s+\(quilt\)\s*$/) {
        $self->{native} = 0;
    } else {
        my $version = $self->field('version');
        $version =~ s/^\d+://;
        my $name = $self->{name};
        $self->{native} = (-f "${name}_${version}.diff.gz" ? 0 : 1);
    }
    return $self->{native};
}

# Returns a hash of binaries to the package type, assuming a type of deb
# unless the package type field is present.
sub binaries {
    my ($self) = @_;
    return $self->{binaries} if exists $self->{binaries};
    my %binaries;
    # sub binaries Needs-Info source-control-file
    opendir(BINPKGS, 'control') or fail("can't open control directory: $!");
    for my $package (readdir BINPKGS) {
        next if $package =~ /^\.\.?$/;
        my $type = $self->binary_field($package, 'xc-package-type') || 'deb';
        $binaries{$package} = lc $type;
    }
    closedir BINPKGS;
    $self->{binaries} = \%binaries;
    return $self->{binaries};
}

# Returns the value of a control field for a binary package or the empty
# string if that control field isn't present.  This does not implement
# inheritance from the settings in the source stanza.
sub binary_field {
    my ($self, $package, $field) = @_;
    return $self->{binary_field}{$package}{$field}
        if exists $self->{binary_field}{$package}{$field};
    my $value = '';
    # sub binary_field Needs-Info source-control-file
    if (-f "control/$package/$field") {
        $value = slurp_entire_file("control/$package/$field");
        chomp $value;
    }
    $self->{binary_field}{$package}{$field} = $value;
    return $self->{binary_field}{$package}{$field};
}

# Return a Maemian::Relation object for the given relationship field in a
# binary package.  In addition to all the normal relationship fields, the
# following special field names are supported:  all (pre-depends, depends,
# recommends, and suggests), strong (pre-depends and depends), and weak
# (recommends and suggests).
sub binary_relation {
    my ($self, $package, $field) = @_;
    $field = lc $field;
    return $self->{binary_relation}->{$package}->{$field}
        if exists $self->{binary_relation}->{$package}->{$field};

    my %special = (all    => [ qw(pre-depends depends recommends suggests) ],
                   strong => [ qw(pre-depends depends) ],
                   weak   => [ qw(recommends suggests) ]);
    my $result;
    if ($special{$field}) {
        my $merged;
        for my $f (@{ $special{$field} }) {
	    # sub binary_relation Needs-Info :binary_field
            my $value = $self->binary_field($f);
            $merged .= ', ' if (defined($merged) and defined($value));
            $merged .= $value if defined($value);
        }
        $result = $merged;
    } else {
        my %known = map { $_ => 1 }
            qw(pre-depends depends recommends suggests enhances breaks
               conflicts provides replaces);
        croak("unknown relation field $field") unless $known{$field};
        my $value = $self->binary_field($field);
        $result = $value if defined($value);
    }
    $result = Maemian::Relation->new($result);
    $self->{binary_relation}->{$package}->{$field} = $result;
    return $self->{binary_relation}->{$field};
}

# Returns the information from collect/file-info.
sub file_info {
    my ($self) = @_;
    return $self->{file_info} if exists $self->{file_info};

    my %file_info;
    # sub file_info Needs-Info file-info
    open(my $idx, '<', "file-info") or fail("cannot open file-info: $!");
    while (<$idx>) {
        chomp;
        m/^(.+?):\s+(.*)$/o or fail("cannot parse file output: $_");
        my ($file, $info) = ($1,$2);
        $file =~ s,^\./,,o;
        $file =~ s,/+$,,o;
        $file_info{$file} = $info;
    }
    close $idx;
    $self->{file_info} = \%file_info;
    return $self->{file_info};
}

# Return a Maemian::Relation object for the given build relationship
# field.  In addition to all the normal build relationship fields, the
# following special field names are supported:  build-depends-all
# (build-depends and build-depends-indep) and build-conflicts-all
# (build-conflicts and build-conflicts-indep).
# sub relation Needs-Info <>
sub relation {
    my ($self, $field) = @_;
    $field = lc $field;
    return $self->{relation}->{$field} if exists $self->{relation}->{$field};

    my $result;
    if ($field =~ /^build-(depends|conflicts)-all$/) {
        my $type = $1;
        my $merged;
        for my $f ("build-$type", "build-$type-indep") {
            my $value = $self->field($f);
            $merged .= ', ' if (defined($merged) and defined($value));
            $merged .= $value if defined($value);
        }
        $result = $merged;
    } elsif ($field =~ /^build-(depends|conflicts)(-indep)?$/) {
        my $value = $self->field($field);
        $result = $value if defined($value);
    } else {
        croak("unknown relation field $field");
    }
    $self->{relation}->{$field} = Maemian::Relation->new($result);
    return $self->{relation}->{$field};
}

# Similar to relation(), return a Maemian::Relation object for the given build
# relationship field, but ignore architecture restrictions.  It supports the
# same special field names.
# sub relation_noarch Needs-Info <>
sub relation_noarch {
    my ($self, $field) = @_;
    $field = lc $field;
    return $self->{relation_noarch}->{$field}
        if exists $self->{relation_noarch}->{$field};

    my $result;
    if ($field =~ /^build-(depends|conflicts)-all$/) {
        my $type = $1;
        my $merged;
        for my $f ("build-$type", "build-$type-indep") {
            my $value = $self->field($f);
            $merged .= ', ' if (defined($merged) and defined($value));
            $merged .= $value if defined($value);
        }
        $result = $merged;
    } elsif ($field =~ /^build-(depends|conflicts)(-indep)?$/) {
        my $value = $self->field($field);
        $result = $value if defined($value);
    } else {
        croak("unknown relation field $field");
    }
    $self->{relation_noarch}->{$field}
        = Maemian::Relation->new_noarch($result);
    return $self->{relation_noarch}->{$field};
}

=head1 NAME

Maemian::Collect::Source - Maemian interface to source package data collection

=head1 SYNOPSIS

    my ($name, $type) = ('foobar', 'source');
    my $collect = Maemian::Collect->new($name, $type);
    if ($collect->native) {
        print "Package is native\n";
    }

=head1 DESCRIPTION

Maemian::Collect::Source provides an interface to package data for source
packages.  It implements data collection methods specific to source
packages.

This module is in its infancy.  Most of Maemian still reads all data from
files in the laboratory whenever that data is needed and generates that
data via collect scripts.  The goal is to eventually access all data about
source packages via this module so that the module can cache data where
appropriate and possibly retire collect scripts in favor of caching that
data in memory.

=head1 CLASS METHODS

=over 4

=item new(PACKAGE)

Creates a new Maemian::Collect::Source object.  Currently, PACKAGE is
ignored.  Normally, this method should not be called directly, only via
the Maemian::Collect constructor.

=back

=head1 INSTANCE METHODS

In addition to the instance methods listed below, all instance methods
documented in the Maemian::Collect module are also available.

=over 4

=item binaries()

Returns a hash reference with the binary package names as keys and the
Package-Type as value (which should be either C<deb> or C<udeb>
currently).  The source-control-file collection script must have been run
to parse the F<debian/control> file and put the fields in the F<control>
directory in the lab.

=item binary_field(PACKAGE, FIELD)

Returns the content of the field FIELD for the binary package PACKAGE in
the F<debian/control> file, or an empty string if that field isn't set.
Inheritance of field values from the source section of the control file is
not implemented.  Only the literal value of the field is returned.

The source-control-file collection script must have been run to parse the
F<debian/control> file and put the fields in the F<control> directory in
the lab.

=item binary_relation(PACKAGE, FIELD)

Returns a Maemian::Relation object for the specified FIELD in the binary
package PACKAGE in the F<debian/control> file.  FIELD should be one of the
possible relationship fields of a Debian package or one of the following
special values:

=over 4

=item all

The concatenation of Pre-Depends, Depends, Recommends, and Suggests.

=item strong

The concatenation of Pre-Depends and Depends.

=item weak

The concatenation of Recommends and Suggests.

=back

If FIELD isn't present in the package, the returned Maemian::Relation
object will be empty (always satisfied and implies nothing).

Any substvars in F<debian/control> will be represented in the returned
relation as packages named after the substvar.

=item changelog()

Returns the changelog of the source package as a Parse::DebianChangelog
object, or undef if the changelog is a symlink or doesn't exist.  The
debfiles collection script must have been run to create the changelog
file, which this method expects to find in F<debfiles/changelog>.

=item native()

Returns true if the source package is native and false otherwise.

=item relation(FIELD)

Returns a Maemian::Relation object for the given build relationship field
FIELD.  In addition to the normal build relationship fields, the
following special field names are supported:

=over 4

=item build-depends-all

The concatenation of Build-Depends and Build-Depends-Indep.

=item build-conflicts-all

The concatenation of Build-Conflicts and Build-Conflicts-Indep.

=back

If FIELD isn't present in the package, the returned Maemian::Relation
object will be empty (always satisfied and implies nothing).

=item relation_noarch(FIELD)

The same as relation(), but ignores architecture restrictions in the
FIELD field.

=back

=head1 AUTHOR

Originally written by Russ Allbery <rra@debian.org> for Maemian.

=head1 SEE ALSO

lintian(1), Maemian::Collect(3), Maemian::Relation(3)

=cut

1;

# Local Variables:
# indent-tabs-mode: nil
# cperl-indent-level: 4
# End:
# vim: syntax=perl sw=4 sts=4 ts=4 et shiftround
