From: Don Armstrong Date: Tue, 31 Mar 2009 23:43:46 +0000 (+0000) Subject: add rudimentary version of cran2deb X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=58e6495442e391f2cd3822792e354e255210fe21;p=bin.git add rudimentary version of cran2deb --- diff --git a/cran2deb b/cran2deb new file mode 100755 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 . +# $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} <{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} <{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} <{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} <{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__