package DhMakeELPA::Command::Packaging; use strict; use warnings; use Cwd; use File::Basename qw{basename}; use File::Grep qw{fgrep}; use Array::Utils qw{array_minus}; use DhMakeELPA::MELPA; use File::Copy; use File::Find::Rule; use File::Spec::Functions qw(catfile); use Git::Repository; use base 'DhMakePerl::Command::Packaging'; __PACKAGE__->mk_accessors( qw( main_dir debian_dir bins control pkgname homepage elpa_version copyright gpl_version ) ); use constant debstdversion => '3.9.8'; sub extract_basic { my $self = shift; $self->debian_dir( $self->main_file('debian') ); $self->find_bins(); $self->pkgname(basename(cwd())); # TODO better? $self->elpa_version($self->extract_version()); # Find the homepage, license and copyright by looking at the root # .el file, if it exists, of the binary package with the shortest # name, then the second shortest etc. This might leave any of # these three undefined foreach my $bin (sort {length($a) <=> length($b)} keys %{$self->bins}) { my $fh = $self->_file_r( $self->main_file("$bin.el") ); while (my $line = $fh->getline()) { if ($line =~ /^;; (X-)*URL: /) { chomp(my $homepage = $'); $self->homepage($homepage); } elsif ($line =~ /^;; Copyright /) { chomp(my $copyright = $'); $copyright =~ s/ / /g; $self->copyright($copyright); } elsif ($line =~ /either version 2/) { $self->gpl_version("2"); } elsif ($line =~ /either version 3/) { $self->gpl_version("3"); } } $fh->close; if (defined $self->homepage) { last; } } } sub output_caveat { my $self = shift; print <main_dir . "/*.el"); my @pkg_files = glob($self->main_dir . "/*-pkg.el"); @el_files = array_minus( @el_files, @pkg_files ); # try to ensure that the 'root' .el file is at the front of the list @el_files = sort { length $a cmp length $b } @el_files; my $single_bin = sub { my $bin = basename($el_files[0]) =~ s/\.el$//r; $self->bins({ "$bin" => ["*.el"] }); }; if (@el_files == 1) { &$single_bin(); } else { $self->bins({}); # there could be -pkg.el files that don't have an associated .el # file (e.g. helm-core-pkg.el) so add those back in to the list # we're going to check @el_files = (@el_files, grep { $_ =~ s/-pkg//; ! -f $_} @pkg_files); foreach my $el (@el_files) { my $pkg = $el =~ s/\.el$/-pkg.el/r; my $name = basename($el) =~ s/\.el$//r; # see if this package is a root package file: either it has an # accompanying -pkg.el, or it contains a Package-Version: line if (-f "$pkg" || fgrep { /^;; Package-Version:/ } $el) { my @files = package_files_list($name); $self->bins->{$name} = \@files; } } # fallback: if we failed to figure out the bins, just use a # single one if ( scalar %{$self->bins} eq 0) { &$single_bin(); } } } sub create_elpa { my $self = shift; if (keys %{$self->bins} le 1) { my $fh = $self->_file_w( $self->debian_file('elpa') ); $fh->print( "*.el\n" ); $fh->close; } else { foreach my $bin ( keys %{$self->bins} ) { my @files = @{$self->bins->{$bin}}; my $fh = $self->_file_w( $self->debian_file("elpa-$bin.elpa") ); foreach my $file (@files) { $fh->print("$file\n"); } $fh->close; } } } # from dh-make-perl sub fill_maintainer { my $self = shift; my $src = $self->control->source; my $maint = $self->get_developer; if ( $self->cfg->pkg_emacsen ) { my $pkg_emacsen_maint = "Debian Emacs addons team "; unless ( ( $src->Maintainer // '' ) eq $pkg_emacsen_maint ) { my $old_maint = $src->Maintainer; $src->Maintainer($pkg_emacsen_maint); $src->Uploaders->add($old_maint) if $old_maint; } $src->Uploaders->add($maint); } else { $src->Maintainer($maint); } } sub fill_vcs { my $self = shift; my $src = $self->control->source; if ( $self->cfg->pkg_emacsen ) { $src->Vcs_Git( sprintf( "https://anonscm.debian.org/git/pkg-emacsen/pkg/%s.git", $self->pkgname ) ); $src->Vcs_Browser( sprintf( "https://anonscm.debian.org/cgit/pkg-emacsen/pkg/%s.git/", $self->pkgname ) ); } } # TODO Emacs might be able to extract this information better than we # can: it can generate -pkg.el files from .el files sub extract_description { my ($self, $el_file) = @_; my ($short_desc, $long_desc); my $pkg_file = $el_file =~ s/\.el/-pkg.el/r; if ( -e $pkg_file ) { my $fh = $self->_file_r($pkg_file); my $lines = join("", $fh->getlines); $lines =~ s/\n//g; $short_desc = $lines =~ s/.*\(define-package\s+"[^"]+"\s+"[^"]+"\s+"([^"]+)".*/$1/rg; $fh->close; } if ( -e $el_file ) { # helm-core.el doesn't exist, though helm-core-pkg.el does my $fh = $self->_file_r($el_file); unless (defined $short_desc) { my $line = $fh->getline; $short_desc = $line =~ s/^.*--- (.*)$/$1/r =~ s/-\*- .* -\*-//r; } my $lines = join("", $fh->getlines); if ( $lines =~ /;;; Commentary:/ ) { $lines =~ /.*Commentary:\n\n(.*?)\n\n;;; Code:.*/s; if ( defined $1 ) { $long_desc = $1 =~ s/;; //rsg; } } $fh->close; } unless (defined $short_desc) { $short_desc = "couldn't determine short description" } unless (defined $long_desc) { $long_desc = "couldn't determine long description" } return ($short_desc, $long_desc); } sub extract_version { my $self = shift; my $version; foreach my $bin ( keys %{$self->bins} ) { if ( -f $self->main_file("$bin.el") ) { my $fh = $self->_file_r("$bin.el"); while (my $line = $fh->getline) { if ( $line =~ /^;; (Package-)*Version\s*:\s+([0-9.a-zA-Z~+-]*)$/ ) { $version = "$2"; last; } } $fh->close; last; } elsif ( -f $self->main_file("$bin-pkg.el") ) { my $fh = $self->_file_r("$bin-pkg.el"); while (my $line = $fh->getline) { if ( $line =~ /.*\(define-package\s+"[^"]+"\s+"([0-9.a-zA-Z~+-]*)"/ ) { $version = "$1"; last; } } $fh->close; last; } } if (defined $version) { return $version; } else { die "Could not determine package version by examining *.el files"; } } # TODO upstream tag format should be detected from the git repository, # rather than making the (reasonable) assumption it's of the form # "v1.0.0" sub create_gbp_conf { my $self = shift; my $file = $self->debian_file('gbp.conf'); my $gbpname = "gbp.conf"; for my $source ( catfile( $self->cfg->home_dir, $gbpname ), catfile( $self->cfg->data_dir, $gbpname ) ) { if ( -e $source ) { print "Using gbp-conf: $source\n" if $self->cfg->verbose; copy($source, $file); last; }; } } # TODO more complex case with more than one binary package sub create_docs { my $self = shift; if ( keys %{$self->bins} le 1 && glob("*.md") gt 0 ) { my $fh = $self->_file_w( $self->debian_file('docs') ); $fh->print( "*.md\n" ); $fh->close; } } # TODO document that this relies on having a remote called 'upstream' # TODO again, assumes tags are of the form v1.0.0 sub create_watch { my $self = shift; if ( my $repo = Git::Repository->new( git_dir => $self->main_file('.git') ) ) { my $upstream_url; eval { $upstream_url = $repo->run(( "remote", "get-url", "upstream" )) }; unless ($@) { my $fh = $self->_file_w( $self->debian_file("watch") ); $fh->printf("version=4\nopts=\"mode=git\" %s refs/tags/v([\\d\\.\\d\\.]+) debian", $upstream_url); $fh->close; } } } sub detect_buttercup_tests { my $self = shift; my @files = File::Find::Rule ->file() ->grep( "\\(describe " ) ->in('.'); if ( scalar @files ) { return 1; } else { return 0; } } 1;