#! /usr/bin/perl
# cran2deb turns R packages in to debs, and is released
# under the terms of the GPL version 2, or any later version, at your
# option. See the file README and COPYING for more information.
# Copyright 2008 by Don Armstrong <don@donarmstrong.com>.
# $Id: perl_script 1352 2009-01-25 02:04:38Z don $


use warnings;
use strict;

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

=head1 NAME

cran2deb - turn a cran package into a rudimentary Debian package

=head1 SYNOPSIS

 [options]

 Options:
  --debug, -d debugging level (Default 0)
  --help, -h display this help
  --man, -m display manual

=head1 OPTIONS

=over

=item B<--debug, -d>

Debug verbosity. (Default 0)

=item B<--help, -h>

Display brief usage information.

=item B<--man, -m>

Display this manual.

=back

=head1 EXAMPLES


=cut


use Cwd;
use POSIX qw(strftime);

use Text::Wrap qw(wrap);
use IO::File;

use vars qw($DEBUG $VERSION);

$VERSION='0.1';

my %options = (debug           => 0,
	       help            => 0,
	       man             => 0,
	       );

GetOptions(\%options,
	   'debug|d+','help|h|?','man|m');

pod2usage() if $options{help};
pod2usage({verbose=>2}) if $options{man};

$DEBUG = $options{debug};

my @USAGE_ERRORS;
#if (1) {
#     push @USAGE_ERRORS,"You must pass something";
#}

pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;


my $DEBVERPREPEND = "0.r2d.";

# function for lowcasing package names:
sub lowerCase {
    my $name = shift;

    #my $oldname=$name;
    $name =~ tr/[A-Z]/[a-z]/;
    $name =~ s/(\d*)-(\d)/$1\.$2/;

    #print "lowerCase: $oldname -> $name\n";
    return $name;
}

sub write_rules {
    my ( $pkg, $maintainer ) = @_;
    my $repository = $pkg->{Repository};
    my $name       = $pkg->{DebName};

    my $file = $pkg->{BuildDir} . "/debian/rules";
    my $fh = IO::File->new($file,'w') or die "unable to open $file for writing: $!";

    print "generating rules ...\n" if $DEBUG;

    my $year = strftime '%Y',gmtime;
    my $now = strftime '%a %b %e %Y', gmtime;
    print {$fh} <<EOF;
#!/usr/bin/make -f
# -*- makefile -*-
# debian/rules file for the Debian/GNU Linux package \'r-$repository-$name\'
# Copyright 2004-$year by $maintainer
#
# automatically generated on $now by cran2deb (DLA mod)

debRreposname=$repository
extraInstallFlags=--no-html --no-latex
include /usr/share/R/debian/r-cran.mk
include /usr/share/cdbs/1/rules/dpatch.mk
include /usr/share/dpatch/dpatch.make
EOF
    # if the package is a binary packages, we need to clean.
    if ( $pkg->{isBinary} ) {
        print {$fh}
          "clean::\n\trm -f `find src -name \"*.o\" -o -name \"*.so\"`\n\n";
    }

    $fh->close();
    chmod( 0755, $file ) or die "Cannot chmod $file: $!\n";
}

sub isbinary {
    my ($pkg) = @_;
    if ( !exists( $pkg->{isBinary} ) ) {
        if (-e "$pkg->{BuildDir}/src")
        {
            $pkg->{isBinary} = 1;
        }
        else {
            $pkg->{isBinary} = 0;
        }
    }
}

sub write_control {
    my ( $pkg, $maintainer) = @_;
    my $repository = $pkg->{Repository};

    #print Dumper(\$pkg);
    my $file = $pkg->{BuildDir} . "/debian/control";
    my $control = IO::File->new($file,'w') or die "unable to open $file for writing: $!";
    print "generating control ...\n" if $DEBUG;

    my $indep = "";

    if ( $pkg->{isBinary} ) {
        $pkg->{arch}     = "any";
        $pkg->{archdeps} = "\${shlibs:Depends}, ";
    }
    else {
        $pkg->{arch}     = "all";
        $pkg->{archdeps} = "";
    }

    my $dps = "";
    $dps = join( ", ", @{ $pkg->{debiandependencies} } )
      if ( defined $pkg->{debiandependencies} );
    if   ( $dps !~ // ) {
        $dps = ", " . $dps;
    }
    my $bdps = "";
    $bdps = join( ", ", @{ $pkg->{debianbuilddependencies} } )
      if ( defined $pkg->{debianbuilddependencies} );
    if   ( $bdps !~ // ) {
        $bdps = ", " . $bdps;
    }

    print {$control} "Source: $pkg->{DebName}\n";
    print {$control} "Section: "
      . (
        ( "" eq $pkg->{section} or "main" eq $pkg->{section} )
        ? ""
        : "$pkg->{section}/"
      ) . "math\n";
    print {$control} "Priority: optional\n"
      . "Maintainer: $maintainer\n"
      . "Standards-Version: 3.7.0\n"
      . "Build-Depends$indep: r-base-dev (>= 2.6.0), debhelper (>> 4.0.0), cdbs"
      . "$bdps\n";

    #$Text::Wrap::columns = 720;    # No wrapping of the URL
    if ( exists( $pkg->{URL} ) ) { # URL from DESCRIPTION:
        print {$control} "Homepage: " . $pkg->{URL} . "\n";
    }

    print {$control} "\n"
      . "Package: "
      . $pkg->{DebNamePackage} . "\n"
      . "Architecture: "
      . $pkg->{arch} . "\n"
      . "Depends: "
      . $pkg->{archdeps}
      . " r-base-core (>= 2.6.0) $dps\n";

    my $p = $pkg->{Package};

    # TODO false !
#     print {$control} "Recommends: "
#       . join( ", ", @{ $main::globalstuff{recommends}{$p} } ) . "\n"
#       if exists( $main::globalstuff{recommends}{$p} );
#     print {$control} "Suggests: "
#       . join( ", ", @{ $main::globalstuff{suggests}{$p} } ) . "\n"
#       if exists( $main::globalstuff{suggests}{$p} );

    local $Text::Wrap::columns = 72;    # wrap the Description per Debian Policy

    if ( length( $pkg->{Title} ) < 50 ) {
        print {$control} "Description: GNU R package \"$pkg->{Title}\"\n";
    }
    else {
        print {$control} "Description: GNU R package \""
          . substr( $pkg->{Title}, 0, 50 ), "...\"\n";
        print {$control} wrap( " ", " ", $pkg->{Title}, ".\n" );
    }

    my $desc;

    if ( !defined( $pkg->{Contains} ) ) {
        $desc = $pkg->{Description};
    }
    else {
        $desc = $pkg->{BundleDescription};
    }
    $desc =~ s/\s+/ /g;

    print {$control} wrap( " ", " ", $desc, "\n" );

    print {$control} " .\n"
      . wrap( " ", " ",
        "Author" . ( $pkg->{Author} =~ /,|(\sand\s)/ ? "s" : "" ) . ": ",
        $pkg->{Author}, "\n" )
      if exists( $pkg->{Author} );

    print {$control} wrap( " ", " ", "Date: ", $pkg->{Date}, "\n" )
      if exists( $pkg->{Date} );

    if ( exists( $pkg->{Tag} ) ) {
        if ( defined( $pkg->{Tag} ) ) {
            print {$control} "Tag: " . $pkg->{Tag} . "\n";
        }
    }
    $control->close;
}

sub write_copyright {
    my ( $pkg, $maintainer ) = @_;
    my $repository = $pkg->{Repository};

    my $license;
    if ( !defined( ( $pkg->{License} ) ) ) {
        $license = "unknown";
    }
    else {
        $license = $pkg->{License};
        $license =~ s/\n//g;
    }
    my $file = $pkg->{BuildDir} . "/debian/copyright";
    my $copyright = IO::File->new($file,'w') or die "unable to open $file for writing: $!";
    print "generating copyright ...\n" if $DEBUG;
    print {$copyright} <<EOT;
This is the Debian GNU/Linux $pkg->{DebName} package of $pkg->{Package}.
It was written by $pkg->{Author}.

This package was created by $maintainer
using the automated build script cran2deb version $VERSION. Cran2deb 
is a modified and extended version of Albrecht Gebhardt's build script
	http://www.math.uni-klu.ac.at/~agebhard/build-R-contrib-debs.pl
The package sources were downloaded from 
        http://cran.us.r-project.org/src/contrib/
and should also be available on any other mirror of http://cran.r-project.org.

The package was renamed from its upstream name \'$pkg->{Package}\' to \'r-cran-$pkg->{DebName}\'
to fit the pattern of CRAN packages for R.

The Copyright, as asserted in the DESCRIPTION file, is:
$license

On a Debian GNU/Linux system, common licenses are included in the directory
/usr/share/common-licenses/.

For reference, the upstream DESCRIPTION can be found at
/usr/lib/R/site-library/$pkg->{Package}/DESCRIPTION

EOT
    $copyright->close;
}

sub write_readme {
    my ( $pkg, $maintainer ) = @_;

    my $file = $pkg->{BuildDir} . "/debian/README.Debian";
    my $readme = IO::File->new($file,'w') or die "unable to open $file for writing: $!";
    print "generating README.Debian ...\n" if $DEBUG;
    my $date = strftime "%a, %e %b %Y %H:%M:%S %z", localtime;
    my $repository = 'Unknown';
    my $repository_url = 'an unknown location';
    if ($pkg->{Repository} =~ /bioc/) {
	$repository = 'BioConductor project';
	$repository_url = 'http://www.bioconductor.org/';
    }
    elsif ($pkg->{Repository} =~ /omegahat/) {
	$repository = 'Omegahat';
	$repository_url = 'http://www.omegahat.org/';
    }
    else {
	$repository = 'Comprehensive R Archive Network';
	$repository_url = 'http://cran.r-project.org/';
    }
    print {$readme} <<EOF;
$pkg->{DebName} for Debian

This Debian package was created from sources on the
$repository site, accessible at
${repository_url}.

The package was built using the script cran2deb, which was derived from
	http://www.math.uni-klu.ac.at/~agebhard/build-R-contrib-debs.pl
by Albrecht Gebhard. This script is now maintained by the pkg-bioc
project on
    http://alioth.debian.org/projects/pkg-bioc/

Since the packaging was performed in a semi-automated setup, one should
not expect the Debian packages to match those in quality that are
accessible via the main Debian distribution. At the same time we
express our belief that an automated build can closely match the
installation via methods intrinsic to R in actuality with a considerably
lower administrative burden particularly for a larger number of machines.

All users are welcomed to join in and aid improving on the packages
or their documentation.

 -- $maintainer  $date
EOF
    $readme->close;
}

sub write_changelog {
    my ( $pkg, $maintainer) = @_;

    my $file   = $pkg->{BuildDir} . "/debian/changelog";

    print "generating changelog ...\n" if $DEBUG;

    my $changelog = IO::File->new($file,'w') or die "unable to open $file for writing: $!";

    my $date = POSIX::strftime "%a, %e %b %Y %H:%M:%S %z", localtime;
    print {$changelog} <<EOT;
$pkg->{DebName} ($pkg->{DebRelease}) unstable; urgency=low

  * mechanically generated using cran2deb for $maintainer

 -- $maintainer  $date

EOT
    $changelog->close;
}


if (not -e 'DESCRIPTION') {
    die "Doesn't appear to be an R package";
}
my $pkg;
# read in description file
my $description_fh = IO::File->new('DESCRIPTION','r') or
    die "Unable to open DESCRIPTION for reading: $!";
my $description = '';
{
    local $/;
    $description = <$description_fh>;
}
$description =~ s/^\#[^\n]+//g;
$description =~ s/\n\s+//g;
my %description = map {/^([^:]+):\s+(.+)/?(lc($1),$2):()} split /\n/, $description;

my %pkg;
$pkg{BuildDir} = getcwd;
$pkg{Repository} = 'cran';
$pkg{DebName} = 'r-cran-'.lc($description{package});
$pkg{DebNamePackage} = $pkg{DebName};
$pkg{Package} = $description{package};
$pkg{Author} = $description{author};
$pkg{DebRelease} = $description{version}.'-1';
$pkg{Title} = $description{title};
$pkg{Description} = defined $description{contains}?$description{bundledescription}:$description{description};
$pkg{License} = $description{license};
$pkg{section} = 'main';
mkdir('debian') if not -d 'debian';
my $maint = 'Don Armstrong <don@debian.org>';
isbinary(\%pkg);
write_control(\%pkg,$maint);
write_copyright(\%pkg,$maint);
write_rules(\%pkg,$maint);
write_readme(\%pkg,$maint);
write_changelog(\%pkg,$maint);


__END__