]> git.donarmstrong.com Git - bin.git/commitdiff
add rudimentary version of cran2deb
authorDon Armstrong <don@donarmstrong.com>
Tue, 31 Mar 2009 23:43:46 +0000 (23:43 +0000)
committerDon Armstrong <don@donarmstrong.com>
Tue, 31 Mar 2009 23:43:46 +0000 (23:43 +0000)
cran2deb [new file with mode: 0755]

diff --git a/cran2deb b/cran2deb
new file mode 100755 (executable)
index 0000000..f6f6da8
--- /dev/null
+++ b/cran2deb
@@ -0,0 +1,401 @@
+#! /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 vars qw($DEBUG);
+
+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\n";
+#
+# 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 (   areHereFilesToCompile( $pkg->{BuildDir} . "/src" )
+            or areHereFilesToCompile( $pkg->{BuildDir} ) )
+        {
+            $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 r-$repository-$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 $main::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;
+r-$pkg->{Repository}-$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 $dbfile = $dbdir . "/" . $pkg->{DebName};
+    my $file   = $pkg->{BuildDir} . "/debian/changelog";
+
+    print "generating changelog ...\n" if $main::verbose;
+
+    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 =~ 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{Title} = $description{title};
+$pkg{Description} = defined $description{contains}?$description{bundledescription}:$description{description};
+$pkg{License} = $description{license};
+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__