#!/usr/bin/perl -w

##  Copyright (C) 2001  Denis Barbier <barbier@debian.org>
##
##  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.

=head1 NAME

Debian::Pkg::DebSrc - extract contents from Debian source package

=head1 SYNOPSIS

 use Debian::Pkg::DebSrc;
 my $deb = Debian::Pkg::DebSrc->new("/path/to/foo_0.1-1.dsc");
 my @list = $deb->list_files();
 my $body = $deb->file_content("debian/control");

=head1 DESCRIPTION

This module extracts informations and files from a Debian source
package.  It is built upon the C<Debian::Pkg::Tar> module, see
its documentation for further details on available methods.

=head1 METHODS

=over 4

=cut

package Debian::Pkg::DebSrc;

use Debian::Pkg::Tar;
@ISA = ("Debian::Pkg::Tar");

use strict;
use Carp;

=item new

This is the constructor.

   my $deb = Debian::Pkg::DebSrc->new("/path/to/foo_0.1-1.dsc");

Basically, C<dsc> file is parsed to read tarball and patch file
names, then C<Debian::Pkg::Tar-E<gt>new> is called with tarball
filename being first argument.  When a patch file is found,
C<Debian::Pkg::Tar-E<gt>bind_patch> method is invoked.
Optional arguments with a C<patch_> prefix are passed along to the
latter (with the prefix removed), whereas other arguments are passed
along to the former.

   my $deb = Debian::Pkg::DebSrc->new("/path/to/foo_0.1-1.dsc",
        parse_dft => 0,
        patch_parse_dft => -1,
   );

is almost equivalent to

   my $deb = Debian::Pkg::Tar->new("/path/to/foo_0.1.orig.tar.gz",
        parse_dft => 0,
   );
   $deb->bind_patch( parse_dft => -1 );
   $deb->parse();

When tarball or patch file is required but does not exist, the C<new>
method returns C<undef> after printing a warning.

=cut

sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $file = shift;

        my $dir  = $file;
        $dir =~ s|/+[^/]*$||;

        my $origtargz = '';
        my $v3targz = '';
        my $diffgz = '';
        open(DSC, "< ".$file) or return undef;
        while (<DSC>) {
                last if m/^Files:/;
        }
        while (<DSC>) {
                chomp;
                last unless s/^ \S* \S* //;
                if (m/\.debian.tar\.(gz|bz2|xz)$/) {
                        $v3targz = $dir . '/' . $_;
                        unless (-f $v3targz) {
                                warn "$v3targz: No such file\n";
                                return undef;
                        }
                } elsif (m/\.tar\.(gz|bz2|xz)$/) {
                        $origtargz = $dir . '/' . $_;
                        unless (-f $origtargz) {
                                warn "$origtargz: No such file\n";
                                return undef;
                        }
                } elsif (m/\.diff\.gz$/) {
                        $diffgz = $dir . '/' . $_;
                        unless (-f $diffgz) {
                                warn "$diffgz No such file\n";
                                return undef;
                        }
                }
        }
        close(DSC);
        if ($origtargz eq '') {
                warn "No tarball\n";
                return undef;
        }
        my $self = $class->SUPER::new("$origtargz", @_);
        bless ($self, $class);

        #   Apply the v3 tarball if found
        if ($v3targz) {
                $self->{v3} = Debian::Pkg::Tar->new("$v3targz", @_, prepend_dir=>1);
                $self->{v3}->parse();
        }

        #   Apply patch if found
        my %patch_opts = ();
        if ($#_ >= 0) {
                my %opts = @_;
                foreach (keys %opts) {
                        next unless s/^patch_//;
                        $patch_opts{$_} = $opts{'patch_'.$_};
                }
        }
        $patch_opts{olddirsuffix} = '.orig'
                if !defined($patch_opts{olddirsuffix});
        $self->bind_patch($diffgz, %patch_opts) if $diffgz ne '';
        $self->parse();
        return $self;
}

=item get_tar_name

Returns the full qualified name of tarball

   my $tarfile = $deb->get_tar_name();

=cut

sub get_tar_name {
        my $self = shift;
        return $self->{name};
}

=item get_diff_name

Returns the full qualified name of the diff file, or empty string if it
does not exist.

   my $patchname = $deb->get_diff_name();

=cut

sub get_diff_name {
        my $self = shift;
        return (defined($self->{patch}) ? $self->{patch}->{name} : '');
}

=item file_matches

Check files matching in origtargz and v3targz

=cut

sub file_matches {
        my $self = shift;
        my $expr = shift;
        my @found = ();

        @found = $self->SUPER::file_matches($expr);

        if ($self->{v3}) {
                my %found;
                foreach (@found) {
                        $found{$_} = 1
                }
                my @found2 = $self->{v3}->file_matches($expr);
                foreach (@found2) {
                        push @found, $_
                                unless $found{$_};
                }
        }

        return @found;
}

=item file_exists

Check if a given file exists in origtargz or v3targz

=cut

sub file_exists {
        my $self = shift;
        my $file = shift;

        return (   $self->SUPER::file_exists($file)
                or (defined $self->{v3} and $self->{v3}->file_exists($file)));
}

=item file_content

Get the content of a file from origtargz or v3targz

=cut

sub file_content {
        my $self = shift;
        my $file = shift;
        my $length = shift || -1;
        if (    (defined $self->{v3})
            and $self->{v3}->file_exists($file)) {
                return $self->{v3}->file_content($file, $length);
        }

        return $self->SUPER::file_content($file, $length);
}

=back

=head1 LIMITATIONS

It is a pain to retrieve content of Debian packages when in dbs format,
since C<debian/rules> must be called to apply patches on upstream tarball.
It does not make much sense to use an in-memory representation in such a
case, so this module will surely not try to ease parsing such packages.

=head1 AUTHOR

Copyright (C) 2001  Denis Barbier <barbier@debian.org>

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.

=cut

1;

