#!/usr/bin/perl

#    Copyright  & Licensing at the end

use strict;

# TODO: add support for debian/copyright files in the form that
# dh_make creates them, or at least handle debian/copyright not being
# machine parseable in a nicer way. (replacing the information
# gathered from there with FIXMEs instead of erroring out)

use Dpkg::Control::Info;
use Dpkg::Control;
use Config::Model ;
use Config::Model::Lister ;
use Log::Log4perl qw(:easy) ;
 Log::Log4perl->easy_init($WARN);

sub p {
    my $line = shift;
    print $line . "\n";
}
my $control = Dpkg::Control::Info->new();
my $source  = $control->get_source;
my @pkgs    = $control->get_packages;
my $pkg     = $pkgs[0];
my @files;
my @licenses;
my @descriptions = split( "\n", $pkg->{Description} );
my $short_description = $descriptions[0];

# this snippet does not break when model class are changed
my ( $categories, $appli_info, $appli_map ) =
  Config::Model::Lister::available_models;
my $root_model = $appli_map->{'dpkg-copyright'} ;

my $model = Config::Model->new() ;
my $copyright_obj = $model->instance(root_class_name => $root_model) ->config_root ;

my $changelog_file;
open $changelog_file, '-|', 'dpkg-parsechangelog';
my $changelog = Dpkg::Control->new();
$changelog->parse( $changelog_file, 'debian/changelog' );
close $changelog_file;

my $lang;
if ( $source->{Source} =~ m/-perl$/ ) {
    $lang = 'Perl';
}
elsif ( $source->{Source} =~ m/-ruby$/ ) {
    $lang = 'Ruby';
}
else {
    $lang = 'FIXME';
}

p 'From: ' . $changelog->{Maintainer};
if ( $ENV{SECRETLY_ITP} ) {
    p "To: Debian Bug Tracking System <quiet\@bugs.debian.org>";
}
else {
    p "To: Debian Bug Tracking System <submit\@bugs.debian.org>";
}
p 'Subject: ITP: ' . $source->{Source} . ' -- ' . $short_description;
p 'Date: ' . `date -R`;

# ^ that adds an extra newline ... bwahahahaha!
my $owner;
if ( $source->{Uploaders} ) {
    $owner = $source->{Uploaders};
}
else {
    $owner = $source->{Maintainer};
}
p 'Package: wnpp';
p 'Owner: ' . $owner;
p 'Severity: wishlist';

if ( !$ENV{SECRETLY_ITP} ) {
    if ( $lang eq 'Perl' ) {
        p
            "X-Debbugs-CC: debian-devel\@lists.debian.org,debian-perl\@lists.debian.org";
    }
    else {
        p "X-Debbugs-CC: debian-devel\@lists.debian.org";
    }
}

p;
p '* Package name    : ' . $source->{Source};

my $version = $changelog->{Version};
$version =~ s/-1$//;
p '  Version         : ' . $version;

my $maintainer = join(' ', $copyright_obj->fetch_element('Upstream-Contact')->fetch_all_values) || 'FIXME';
p "  Upstream Author : " . $maintainer;

my $homepage = $source->{Homepage} 
    || $copyright_obj->fetch_element_value('Source')
    || 'FIXME';

my $license = $copyright_obj->grab_value('Files:"*" License short_name') || 'FIXME' ;

p '* URL             : ' . $homepage;
p '* License         : ' . $license ;
p '  Programming Lang: ' . $lang;

my ( $short, $long ) = split( /\n/, $pkg->{Description}, 2 );
p '  Description     : ' . $short;
p;
p $long;

__END__

=head1 NAME

dpt-gen-itp -- generate ITP trivia

=head1 SYNOPSIS

C<< dpt gen-itp> > tmp && $EDITOR tmp && mail < tmp >>

=head1 DESCRIPTION

B<dpt gen-itp> can help in constructing the Intent To Package bug report which
is to be filed when one starts working on a package. The script itself doesn't
send the mail, but prepares the boiler-plate so that you don't have to worry
about the proper format or other trivia.

B<dpt gen-itp> gets the information from F<debian/control> and
F<debian/copyright>, so filling up these files with real data will help.

=head1 COPYRIGHT & LICENSE

Copyright 2009, Ryan Niebur

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 3 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.

=cut
