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