cran2deb

   1 #! /usr/bin/perl
   2 # cran2deb turns R packages in to debs, and is released
   3 # under the terms of the GPL version 2, or any later version, at your
   4 # option. See the file README and COPYING for more information.
   5 # Copyright 2008 by Don Armstrong <don@donarmstrong.com>.
   6 # $Id: perl_script 1352 2009-01-25 02:04:38Z don $
   7
   8
   9 use warnings;
  10 use strict;
  11
  12 use Getopt::Long;
  13 use Pod::Usage;
  14
  15 =head1 NAME
  16
  17 cran2deb - turn a cran package into a rudimentary Debian package
  18
  19 =head1 SYNOPSIS
  20
  21  [options]
  22
  23  Options:
  24   --debug, -d debugging level (Default 0)
  25   --help, -h display this help
  26   --man, -m display manual
  27
  28 =head1 OPTIONS
  29
  30 =over
  31
  32 =item B<--debug, -d>
  33
  34 Debug verbosity. (Default 0)
  35
  36 =item B<--help, -h>
  37
  38 Display brief usage information.
  39
  40 =item B<--man, -m>
  41
  42 Display this manual.
  43
  44 =back
  45
  46 =head1 EXAMPLES
  47
  48
  49 =cut
  50
  51
  52 use Cwd;
  53 use POSIX qw(strftime);
  54
  55 use Text::Wrap qw(wrap);
  56 use IO::File;
  57
  58 use vars qw($DEBUG $VERSION);
  59
  60 $VERSION='0.1';
  61
  62 my %options = (debug           => 0,
  63                help            => 0,
  64                man             => 0,
  65                );
  66
  67 GetOptions(\%options,
  68            'debug|d+','help|h|?','man|m');
  69
  70 pod2usage() if $options{help};
  71 pod2usage({verbose=>2}) if $options{man};
  72
  73 $DEBUG = $options{debug};
  74
  75 my @USAGE_ERRORS;
  76 #if (1) {
  77 #     push @USAGE_ERRORS,"You must pass something";
  78 #}
  79
  80 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
  81
  82
  83 my $DEBVERPREPEND = "0.r2d.";
  84
  85 # function for lowcasing package names:
  86 sub lowerCase {
  87     my $name = shift;
  88
  89     #my $oldname=$name;
  90     $name =~ tr/[A-Z]/[a-z]/;
  91     $name =~ s/(\d*)-(\d)/$1\.$2/;
  92
  93     #print "lowerCase: $oldname -> $name\n";
  94     return $name;
  95 }
  96
  97 sub write_rules {
  98     my ( $pkg, $maintainer ) = @_;
  99     my $repository = $pkg->{Repository};
 100     my $name       = $pkg->{DebName};
 101
 102     my $file = $pkg->{BuildDir} . "/debian/rules";
 103     my $fh = IO::File->new($file,'w') or die "unable to open $file for writing: $!";
 104
 105     print "generating rules ...\n" if $DEBUG;
 106
 107     my $year = strftime '%Y',gmtime;
 108     my $now = strftime '%a %b %e %Y', gmtime;
 109     print {$fh} <<EOF;
 110 #!/usr/bin/make -f
 111 # -*- makefile -*-
 112 # debian/rules file for the Debian/GNU Linux package \'r-$repository-$name\'
 113 # Copyright 2004-$year by $maintainer
 114 #
 115 # automatically generated on $now by cran2deb (DLA mod)
 116
 117 debRreposname=$repository
 118 extraInstallFlags=--no-html --no-latex
 119 include /usr/share/R/debian/r-cran.mk
 120 include /usr/share/cdbs/1/rules/dpatch.mk
 121 include /usr/share/dpatch/dpatch.make
 122 EOF
 123     # if the package is a binary packages, we need to clean.
 124     if ( $pkg->{isBinary} ) {
 125         print {$fh}
 126           "clean::\n\trm -f `find src -name \"*.o\" -o -name \"*.so\"`\n\n";
 127     }
 128
 129     $fh->close();
 130     chmod( 0755, $file ) or die "Cannot chmod $file: $!\n";
 131 }
 132
 133 sub isbinary {
 134     my ($pkg) = @_;
 135     if ( !exists( $pkg->{isBinary} ) ) {
 136         if (-e "$pkg->{BuildDir}/src")
 137         {
 138             $pkg->{isBinary} = 1;
 139         }
 140         else {
 141             $pkg->{isBinary} = 0;
 142         }
 143     }
 144 }
 145
 146 sub write_control {
 147     my ( $pkg, $maintainer) = @_;
 148     my $repository = $pkg->{Repository};
 149
 150     #print Dumper(\$pkg);
 151     my $file = $pkg->{BuildDir} . "/debian/control";
 152     my $control = IO::File->new($file,'w') or die "unable to open $file for writing: $!";
 153     print "generating control ...\n" if $DEBUG;
 154
 155     my $indep = "";
 156
 157     if ( $pkg->{isBinary} ) {
 158         $pkg->{arch}     = "any";
 159         $pkg->{archdeps} = "\${shlibs:Depends}, ";
 160     }
 161     else {
 162         $pkg->{arch}     = "all";
 163         $pkg->{archdeps} = "";
 164     }
 165
 166     my $dps = "";
 167     $dps = join( ", ", @{ $pkg->{debiandependencies} } )
 168       if ( defined $pkg->{debiandependencies} );
 169     if   ( $dps !~ // ) {
 170         $dps = ", " . $dps;
 171     }
 172     my $bdps = "";
 173     $bdps = join( ", ", @{ $pkg->{debianbuilddependencies} } )
 174       if ( defined $pkg->{debianbuilddependencies} );
 175     if   ( $bdps !~ // ) {
 176         $bdps = ", " . $bdps;
 177     }
 178
 179     print {$control} "Source: $pkg->{DebName}\n";
 180     print {$control} "Section: "
 181       . (
 182         ( "" eq $pkg->{section} or "main" eq $pkg->{section} )
 183         ? ""
 184         : "$pkg->{section}/"
 185       ) . "math\n";
 186     print {$control} "Priority: optional\n"
 187       . "Maintainer: $maintainer\n"
 188       . "Standards-Version: 3.7.0\n"
 189       . "Build-Depends$indep: r-base-dev (>= 2.6.0), debhelper (>> 4.0.0), cdbs"
 190       . "$bdps\n";
 191
 192     #$Text::Wrap::columns = 720;    # No wrapping of the URL
 193     if ( exists( $pkg->{URL} ) ) { # URL from DESCRIPTION:
 194         print {$control} "Homepage: " . $pkg->{URL} . "\n";
 195     }
 196
 197     print {$control} "\n"
 198       . "Package: "
 199       . $pkg->{DebNamePackage} . "\n"
 200       . "Architecture: "
 201       . $pkg->{arch} . "\n"
 202       . "Depends: "
 203       . $pkg->{archdeps}
 204       . " r-base-core (>= 2.6.0) $dps\n";
 205
 206     my $p = $pkg->{Package};
 207
 208     # TODO false !
 209 #     print {$control} "Recommends: "
 210 #       . join( ", ", @{ $main::globalstuff{recommends}{$p} } ) . "\n"
 211 #       if exists( $main::globalstuff{recommends}{$p} );
 212 #     print {$control} "Suggests: "
 213 #       . join( ", ", @{ $main::globalstuff{suggests}{$p} } ) . "\n"
 214 #       if exists( $main::globalstuff{suggests}{$p} );
 215
 216     local $Text::Wrap::columns = 72;    # wrap the Description per Debian Policy
 217
 218     if ( length( $pkg->{Title} ) < 50 ) {
 219         print {$control} "Description: GNU R package \"$pkg->{Title}\"\n";
 220     }
 221     else {
 222         print {$control} "Description: GNU R package \""
 223           . substr( $pkg->{Title}, 0, 50 ), "...\"\n";
 224         print {$control} wrap( " ", " ", $pkg->{Title}, ".\n" );
 225     }
 226
 227     my $desc;
 228
 229     if ( !defined( $pkg->{Contains} ) ) {
 230         $desc = $pkg->{Description};
 231     }
 232     else {
 233         $desc = $pkg->{BundleDescription};
 234     }
 235     $desc =~ s/\s+/ /g;
 236
 237     print {$control} wrap( " ", " ", $desc, "\n" );
 238
 239     print {$control} " .\n"
 240       . wrap( " ", " ",
 241         "Author" . ( $pkg->{Author} =~ /,|(\sand\s)/ ? "s" : "" ) . ": ",
 242         $pkg->{Author}, "\n" )
 243       if exists( $pkg->{Author} );
 244
 245     print {$control} wrap( " ", " ", "Date: ", $pkg->{Date}, "\n" )
 246       if exists( $pkg->{Date} );
 247
 248     if ( exists( $pkg->{Tag} ) ) {
 249         if ( defined( $pkg->{Tag} ) ) {
 250             print {$control} "Tag: " . $pkg->{Tag} . "\n";
 251         }
 252     }
 253     $control->close;
 254 }
 255
 256 sub write_copyright {
 257     my ( $pkg, $maintainer ) = @_;
 258     my $repository = $pkg->{Repository};
 259
 260     my $license;
 261     if ( !defined( ( $pkg->{License} ) ) ) {
 262         $license = "unknown";
 263     }
 264     else {
 265         $license = $pkg->{License};
 266         $license =~ s/\n//g;
 267     }
 268     my $file = $pkg->{BuildDir} . "/debian/copyright";
 269     my $copyright = IO::File->new($file,'w') or die "unable to open $file for writing: $!";
 270     print "generating copyright ...\n" if $DEBUG;
 271     print {$copyright} <<EOT;
 272 This is the Debian GNU/Linux $pkg->{DebName} package of $pkg->{Package}.
 273 It was written by $pkg->{Author}.
 274
 275 This package was created by $maintainer
 276 using the automated build script cran2deb version $VERSION. Cran2deb
 277 is a modified and extended version of Albrecht Gebhardt's build script
 278         http://www.math.uni-klu.ac.at/~agebhard/build-R-contrib-debs.pl
 279 The package sources were downloaded from
 280         http://cran.us.r-project.org/src/contrib/
 281 and should also be available on any other mirror of http://cran.r-project.org.
 282
 283 The package was renamed from its upstream name \'$pkg->{Package}\' to \'r-cran-$pkg->{DebName}\'
 284 to fit the pattern of CRAN packages for R.
 285
 286 The Copyright, as asserted in the DESCRIPTION file, is:
 287 $license
 288
 289 On a Debian GNU/Linux system, common licenses are included in the directory
 290 /usr/share/common-licenses/.
 291
 292 For reference, the upstream DESCRIPTION can be found at
 293 /usr/lib/R/site-library/$pkg->{Package}/DESCRIPTION
 294
 295 EOT
 296     $copyright->close;
 297 }
 298
 299 sub write_readme {
 300     my ( $pkg, $maintainer ) = @_;
 301
 302     my $file = $pkg->{BuildDir} . "/debian/README.Debian";
 303     my $readme = IO::File->new($file,'w') or die "unable to open $file for writing: $!";
 304     print "generating README.Debian ...\n" if $DEBUG;
 305     my $date = strftime "%a, %e %b %Y %H:%M:%S %z", localtime;
 306     my $repository = 'Unknown';
 307     my $repository_url = 'an unknown location';
 308     if ($pkg->{Repository} =~ /bioc/) {
 309         $repository = 'BioConductor project';
 310         $repository_url = 'http://www.bioconductor.org/';
 311     }
 312     elsif ($pkg->{Repository} =~ /omegahat/) {
 313         $repository = 'Omegahat';
 314         $repository_url = 'http://www.omegahat.org/';
 315     }
 316     else {
 317         $repository = 'Comprehensive R Archive Network';
 318         $repository_url = 'http://cran.r-project.org/';
 319     }
 320     print {$readme} <<EOF;
 321 $pkg->{DebName} for Debian
 322
 323 This Debian package was created from sources on the
 324 $repository site, accessible at
 325 ${repository_url}.
 326
 327 The package was built using the script cran2deb, which was derived from
 328         http://www.math.uni-klu.ac.at/~agebhard/build-R-contrib-debs.pl
 329 by Albrecht Gebhard. This script is now maintained by the pkg-bioc
 330 project on
 331     http://alioth.debian.org/projects/pkg-bioc/
 332
 333 Since the packaging was performed in a semi-automated setup, one should
 334 not expect the Debian packages to match those in quality that are
 335 accessible via the main Debian distribution. At the same time we
 336 express our belief that an automated build can closely match the
 337 installation via methods intrinsic to R in actuality with a considerably
 338 lower administrative burden particularly for a larger number of machines.
 339
 340 All users are welcomed to join in and aid improving on the packages
 341 or their documentation.
 342
 343  -- $maintainer  $date
 344 EOF
 345     $readme->close;
 346 }
 347
 348 sub write_changelog {
 349     my ( $pkg, $maintainer) = @_;
 350
 351     my $file   = $pkg->{BuildDir} . "/debian/changelog";
 352
 353     print "generating changelog ...\n" if $DEBUG;
 354
 355     my $changelog = IO::File->new($file,'w') or die "unable to open $file for writing: $!";
 356
 357     my $date = POSIX::strftime "%a, %e %b %Y %H:%M:%S %z", localtime;
 358     print {$changelog} <<EOT;
 359 $pkg->{DebName} ($pkg->{DebRelease}) unstable; urgency=low
 360
 361   * mechanically generated using cran2deb for $maintainer
 362
 363  -- $maintainer  $date
 364
 365 EOT
 366     $changelog->close;
 367 }
 368
 369
 370 if (not -e 'DESCRIPTION') {
 371     die "Doesn't appear to be an R package";
 372 }
 373 my $pkg;
 374 # read in description file
 375 my $description_fh = IO::File->new('DESCRIPTION','r') or
 376     die "Unable to open DESCRIPTION for reading: $!";
 377 my $description = '';
 378 {
 379     local $/;
 380     $description = <$description_fh>;
 381 }
 382 $description =~ s/^\#[^\n]+//g;
 383 $description =~ s/\n\s+//g;
 384 my %description = map {/^([^:]+):\s+(.+)/?(lc($1),$2):()} split /\n/, $description;
 385
 386 my %pkg;
 387 $pkg{BuildDir} = getcwd;
 388 $pkg{Repository} = 'cran';
 389 $pkg{DebName} = 'r-cran-'.lc($description{package});
 390 $pkg{DebNamePackage} = $pkg{DebName};
 391 $pkg{Package} = $description{package};
 392 $pkg{Author} = $description{author};
 393 $pkg{DebRelease} = $description{version}.'-1';
 394 $pkg{Title} = $description{title};
 395 $pkg{Description} = defined $description{contains}?$description{bundledescription}:$description{description};
 396 $pkg{License} = $description{license};
 397 $pkg{section} = 'main';
 398 mkdir('debian') if not -d 'debian';
 399 my $maint = 'Don Armstrong <don@debian.org>';
 400 isbinary(\%pkg);
 401 write_control(\%pkg,$maint);
 402 write_copyright(\%pkg,$maint);
 403 write_rules(\%pkg,$maint);
 404 write_readme(\%pkg,$maint);
 405 write_changelog(\%pkg,$maint);
 406
 407
 408 __END__