#!/usr/bin/perl

# damngpl - Extract source package info from Debian status files
# Copyright (C) 2007 Ryan Finnie
#
# 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

# Source:
#   http://blog.finnix.org/2011/08/21/finnix-and-gpl-compliance/
#   http://www.finnie.org/software/damngpl/damngpl

use Getopt::Long;
use Pod::Usage;

$result = GetOptions(
  'help|?' => \$opt_help,
  'man' => \$opt_man,
  'source|s' => \$opt_source,
  'dget|d' => \$opt_dget,
  'snapshot|n' => \$opt_snapshot,
  'nofile|f' => \$opt_nofile,
);

pod2usage(2) if(!$result || $opt_help);
pod2usage(-verbose => 2) if($opt_man);

if(!$opt_source && !$opt_dget && !$opt_snapshot) {
  $opt_source = 1;
}

%config = (
  'source' => $opt_source,
  'dget' => $opt_dget,
  'snapshot' => $opt_snapshot,
  'nofile' => $opt_nofile,
);

if($ARGV[0]) {
  foreach $file (@ARGV) {
    open(FILE, $file) || die("Cannot open $file: $!");
    processstatus(FILE);
    close(FILE);
  }
} else {
  processstatus(STDIN);
}

sub processstatus { # begin sub processstatus
  my($fh) = shift;
  my($package, $status, $version, $source, $sourceversion, $sourceversionnoepoch);
  my($l);

  while($l = <$fh>) { # begin file line loop
    chomp $l;
    if($l eq "") { # begin block check
      # At this point the block is finished.
      if(($status =~ /not-installed/) || !$package || !$status || !$version) {
        # If I can't figure out the block, (possibly) warn and ignore it.
        unless($status =~ /not-installed/) {
          print STDERR "WARN: Cannot figure out block (package '$package', status '$status', version '$version', source '$source', sourceversion '$sourceversion')\n";
        }
        $package = "";
        $status = "";
        $version = "";
        $source = "";
        $sourceversion = "";
        next;
      }
      # If the package doesn't have an explicit source, the source is the same name as the package.
      $source = $package if(!$source);
      $sourceversion = $version;

      # If the source package name has parens in it, the source package version is in the parens,
      # most likely different from the binary package's version.
      if($source =~ /^(.*?) \((.*?)\)$/) {
        $source = $1;
        $sourceversion = $2;
      }

      # +bN is a binNMU, ignore that part of the version number.
      if($sourceversion =~ /^(.*?)\+b\d+$/) {
        $sourceversion = $1;
      }

      # A colon separates the epoch from the rest of the version.
      ($sourceversionnoepoch = $sourceversion) =~ s/^\d+://g;

      if(!$printed{"$source=$sourceversion"}) {
        if(($config{'nofile'}) || (!-e "${source}_$sourceversionnoepoch.dsc")) {
          if($config{'source'}) { print "$source=$sourceversion\n"; }
          if($config{'dget'}) { print "${source}_$sourceversionnoepoch\n"; }
          if($config{'snapshot'}) { print "deb-src http://snapshot.debian.net/archive pool $source\n"; }
          $printed{"$source=$sourceversion"} = 1;
        }
      }

      $package = "";
      $status = "";
      $version = "";
      $source = "";
      $sourceversion = "";
    } else { # else block check
      # If we are still in the middle of a block, continue collecting fields.
      if($l =~ /^Package: (.*?)$/) { $package = $1; }
      if($l =~ /^Status: (.*?)$/) { $status = $1; }
      if($l =~ /^Version: (.*?)$/) { $version = $1; }
      if($l =~ /^Source: (.*?)$/) { $source = $1; }
    } # end block check
  } # end file line loop

} # end sub processstatus

__END__

=head1 NAME

damngpl - Extract source package info from Debian status files

=head1 SYNOPSIS

damngpl [-s] [-d] [-n] [-f] [statusfile [...]]

 Options:
   -s --source   Outputs format "package=1:1.0-1" (default)
   -d --dget     Outputs format "package_1.0-1"
   -n --snapshot Outputs snapshot.debian.net deb-src lines
   -f --nofile   Do not check for .dsc files in current directory
   -? --help     Print this synopsis and exit
      --man      Open man page for this program

=head1 DESCRIPTION

B<damngpl> will parse a Debian-style /var/lib/dpkg/status file and
extract source package information about installed packages.  This
information can be used in several ways, usually to download source
packages.

Multiple input files can be specified on the command line, or piped into
standard input if no files are specified.  Results are returned to
standard output

=head1 ARGUMENTS

=over

=item B<--source>

Outputs results in the format "package=1:1.0-1", suitable for using in
"apt-get --download-only source RESULT".

=item B<--dget>

Outputs results in the format "package_1.0-1", suitable for using in
"dget http://mirror/RESULT.dsc".

=item B<--snapshot>

Outputs results in the format "deb-src
http://snapshot.debian.net/archive pool package", suitable for putting
into /etc/apt/sources.list.

=item B<--nofile>

Normally a result will not be shown if the result's .dsc file exists in
the current directory (as you have already downloaded it).  This option
disables that check.

=back

=head1 EXAMPLES

B<Transfer all possible sources from a local source directory using
dget:>

    for i in $(damngpl -d /var/lib/dpkg/status); do
      dget file:///home/ryan/sources/$i.dsc;
    done

B<Download all possible sources from existing mirrors using apt-get:>

    for i in $(damngpl -s /var/lib/dpkg/status); do
      apt-get --download-only source $i;
    done

B<Add snapshot.debian.net deb-src lines to /etc/apt/sources.list, then
attempt to download:>

    damngpl -n /var/lib/dpkg/status >>/etc/apt/sources.list;
    apt-get update;
    for i in $(damngpl -s /var/lib/dpkg/status); do
      apt-get --download-only source $i;
    done

=head1 AUTHOR

B<damngpl> was written by Ryan Finnie <ryan@finnie.org>.

=head1 NOTES

The name B<damngpl> was chosen as a tongue-in-cheek description of its
purpose (downloading Debian sources for the Finnix project to remain GPL
compliant).  Please do not send hate mail to the author, thinking he is
anti-GPL.  He's not.

Be kind to your neighborhood mirror.  Always check local sources first.
Don't drink and drive.

=cut
