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