view release on metacpan or  search on metacpan

lib/LCFG/Build/VCS.pm  view on Meta::CPAN

    $options //= {};

    $options->{date} ||= DateTime->now->ymd;

    my $dir = (File::Spec->splitpath($logfile))[1];

    my $tmplog = File::Temp->new(
        TEMPLATE => 'lcfgXXXXXX',
        UNLINK   => 1,
        DIR      => $dir,
    );

    my $tmpname = $tmplog->filename;

    $tmplog->print(<<"EOT");
$options->{date}  $options->{id}: new release

\t* Release: $options->{version}

EOT

    if ( -f $logfile ) {
        my $log = IO::File->new( $logfile, 'r' )
            or die "Could not open $logfile: $!\n";

        while ( defined( my $line = <$log> ) ) {
            $tmplog->print($line);
        }

        $log->close;
    }

    $tmplog->close
        or die "Could not close temporary file, $tmpname: $!\n";

    if ( !$options->{dryrun} ) {
        rename $tmpname, $logfile
          or die "Could not rename $tmpname as $logfile: $!\n";
    }

    return;
}

# These update_*_changelog subroutines are also used externally from
# places which do not have access to the VCS object so they are not
# class methods.

sub update_debian_changelog {
    my ( $logfile, $options ) = @_;
    $options //= {};

    $options->{urgency}      ||= 'low';
    $options->{distribution} ||= 'unstable';
    $options->{release}      //= 1;
    $options->{message}      ||= 'New upstream release';

    # RFC822 date
    $options->{date} = DateTime->now->strftime('%a, %d %b %Y %H:%M:%S %z');

    if ( !$options->{email} ) {
        my $user_name = (getpwuid($<))[0];

        my $email_addr = $ENV{DEBEMAIL} || $ENV{EMAIL};

        if ( !$email_addr ) {
            require Net::Domain;

            my $domain = Net::Domain::hostdomain();
            
            $email_addr = join '@', $user_name, $domain;
        }

        # trim any leading or trailing whitespace
        $email_addr =~ s/^\s+//; $email_addr =~ s/\s+$//;

        if ( $email_addr !~ m/<.+>/ ) {
            my $email_name = $ENV{DEBFULLNAME} || $ENV{NAME}  || $user_name;
            $email_name =~ s/^\s+//; $email_name =~ s/\s+$//;

            $email_addr = "$email_name <$email_addr>";
        }

        $options->{email} = $email_addr;
    }

    my ( $dir, $basename ) = (File::Spec->splitpath($logfile))[1,2];

    my $tmplog = File::Temp->new(
        TEMPLATE => 'lcfgXXXXXX',
        UNLINK   => 1,
        DIR      => $dir,
    );
    my $tmpname = $tmplog->filename;

    my $tt = Template->new(
        {
            INCLUDE_PATH => $dir,
        }
    ) or die $Template::ERROR . "\n";

    my $template = q{
[%- FOREACH entry IN entries -%]
[% entry.item('pkgname') %] ([% entry.item('version') %]-[% entry.item('release') %]) [% entry.item('distribution') %]; urgency=[% entry.item('urgency') %]

  * [% entry.item('message') %]

 -- [% entry.item('email') %]  [% entry.item('date') %]

[% END -%]
[% IF current_logfile %][% INSERT $current_logfile %][% END -%]
};

    my %args = (
        entries => [$options],
    );

    if ( -e $logfile ) {
        $args{current_logfile} = $basename;
    }

    $tt->process( \$template, \%args, $tmplog )