view release on metacpan or  search on metacpan

lib/DhMakePerl/Command/Packaging.pm  view on Meta::CPAN

Constructs a file name relative to the main source directory, L</main_dir>

=cut

sub main_file {
    my( $self, $file ) = @_;

    catfile( $self->main_dir, $file );
}

=item debian_file(file_name)

Constructs a file name relative to the debian/ sub-directory of the main source
directory.

=cut

sub debian_file {
    my( $self, $file ) = @_;

    catfile( $self->main_file('debian'), $file );
}

sub build_pl {
    my ($self) = @_;

    return $self->main_file('Build.PL');
}

sub makefile_pl {
    my ($self) = @_;

    return $self->main_file('Makefile.PL');
}

sub get_user {
    return $ENV{LOGNAME} || $ENV{USER};
}

sub get_email {
    my $self = shift;
    my $email = $self->cfg->email;

    $email ||= ( $ENV{DEBEMAIL} || $ENV{EMAIL} );
    unless ($email) {
	my $mailh;
        chomp( $mailh = `cat /etc/mailname` );
        $email = $self->get_user . '@' . $mailh;
    }

    $email =~ s/^(.*)\s+<(.*)>$/$2/;
    return $email;
}

sub get_name {
    my $self = shift;

    my $name;
    my $user = $self->get_user;
    my $pwnam = getpwuid($<);
    die "Cannot determine current user\n" unless $pwnam;
    if ( defined $ENV{DEBFULLNAME} ) {
        $name = $ENV{DEBFULLNAME};
    }
    else {
        $name = $pwnam->gecos;
        $name =~ s/,.*//;
    }
    $user ||= $pwnam->name;
    $name ||= $user;
    return $name;
}

sub get_developer {
    my $self = shift;
    return $self->get_name . " <" . $self->get_email . ">";
}

sub fill_maintainer {
    my $self = shift;

    my $src = $self->control->source;
    my $maint = $self->get_developer;

    if ( $self->cfg->pkg_perl ) {
        my $pkg_perl_maint
            = "Debian Perl Group <pkg-perl-maintainers\@lists.alioth.debian.org>";
        unless ( ( $src->Maintainer // '' ) eq $pkg_perl_maint ) {
            my $old_maint = $src->Maintainer;
            $src->Maintainer($pkg_perl_maint);
            $src->Uploaders->add($old_maint) if $old_maint;
        }

        $src->Uploaders->add($maint);
    }
    else {
        $src->Maintainer($maint);
    }
}

sub process_meta {
    my ($self) = @_;

    $self->meta({});

    # Command line option nometa causes this function not to be run
    if( $self->cfg->nometa ) {
        return;
    }

    my $meta = $self->main_file('META.json');
    if ( -e $meta ) {
        print "Using META.json\n" if $self->cfg->verbose;
    }
    else {
        $meta = $self->main_file('META.yml');
        if ( -e $meta ) {
            print "Using META.yml\n" if $self->cfg->verbose;
        }
        else {