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 TryCatch; 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? if ( $self->cfg->version ) { $self->elpa_version($self->cfg->version); } else { $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 find_bins { my $self = shift; my @el_files = glob($self->main_dir . "/*.el"); unless ( @el_files ) { print "no *.el files in the current directory -- are you running\n"; print "dh-make-elpa in the right place?\n"; exit 1; } 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); } # TODO we might fall back to lookingg at the git tags sub extract_version { my $self = shift; my $version; foreach my $bin ( keys %{$self->bins} ) { if ( -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; } elsif ( -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; } } if (defined $version) { return $version; } else { die "Could not determine package version by examining *.el files.\nPlease specify --version."; } } sub create_gbp_conf { my $self = shift; my ( $content, $repo ); 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; my $fh = $self->_file_r($source); $content = join "", $fh->getlines(); last; }; } # Now we update upstream tag format if necessary: strip the # leading 'v' if there are no tags that match /^v[0-9]/ try { $repo = Git::Repository->new( git_dir => $self->main_file('.git') ); } catch { my $fh = $self->_file_w($file); $fh->write($content); return; }; my @tags = split "\n", $repo->run(("tag")); unless ( grep { /^v[0-9]/ } @tags ) { $content =~ s/upstream-tag\s*=\s*v/upstream-tag = /; } my $fh = $self->_file_w($file); $fh->write($content); } # TODO more complex case with more than one binary package # TODO support .markdown, .mdwn etc. sub create_docs { my $self = shift; my @docs = glob($self->main_dir . "/*.md"); if ( keys %{$self->bins} le 1 && scalar @docs gt 0 ) { my $fh = $self->_file_w( $self->debian_file('docs') ); $fh->print( "*.md\n" ); $fh->close; } else { print "I: couldn't generate d/docs: not fully implemented\n"; } } # TODO again, assumes tags are of the form v1.0.0 sub create_watch { my $self = shift; my ( $repo, $upstream_url ); try { $repo = Git::Repository->new( git_dir => $self->main_file('.git') ); $upstream_url = $repo->run(( "remote", "get-url", "upstream" )); } catch { print "I: couldn't generate d/watch -- no git remote named 'upstream'\n"; return; }; my $fh = $self->_file_w( $self->debian_file("watch") ); $fh->printf("version=4\nopts=\"mode=git\" %s refs/tags/v([\\d\\.\\d\\.]+) debian\n", $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;