view release on metacpan or  search on metacpan

lib/CPANPLUS/Dist/Deb.pm  view on Meta::CPAN

    }

    ### get all the metadata for changelog file and write it ###
    {   my $copyright_file = DEB_COPYRIGHT->( $dist->status->builddir );

        my $fh;
        unless( $fh = FileHandle->new( ">$copyright_file" ) ) {
            error( loc( "Could not open '%1' for writing: %2",
                        $copyright_file, $! ) );
            $dist->status->prepared(0);
            return;
        }

        ### XXX probe for possible license here rather than assume the
        ### default
        my $pkg     = $self->module;
        my $who     = $ENV{DEBFULLMAIL} 
                        ? $ENV{DEBFULLNAME} . ' <' . 
                          ($ENV{DEBEMAIL} || $conf->get_conf('email')) . '>'
                        : ($ENV{DEBEMAIL} || $conf->get_conf('email'));   
        my $when    = 1900 + (localtime)[5];
        my $license = DEB_STANDARD_COPYRIGHT_PERL;
        my $author  = $self->author->author;
        my $email   = $self->author->email;

        $fh->print(<< "EOF");
This is the debian package for the $pkg module.
It was created by $who.

The upstream author is $author <$email>.

Copyright (c) $when by $author

$license

EOF

        $fh->close;
        $dist->status->copyright($copyright_file);
    }

    {   ### add the debian rules file, which is mostly static ###
        my $rules_file  = DEB_RULES->( $dist->status->builddir );
        my $has_xs      = scalar GET_XS_FILES->($self->status->extract)
                                ? 1 : 0;
        my $content     = DEB_GET_RULES_CONTENT->( $self, $prefix, 
                                                    $has_xs, $verbose );

        my $fh;
        unless( $fh = FileHandle->new( ">$rules_file" ) ) {
            error( loc( "Could not open '%1' for writing: %2",
                        $rules_file, $! ) );
            $dist->status->prepared(0);
            return;
        }

        $fh->print( $content );
        $fh->close;

        ### make sure it's set as +x
        chmod 0755, $rules_file;

        $dist->status->rules( $rules_file );
    }

    $dist->status->prepared(1);
    return $dist->status->builddir;
}

=pod

=head2 $loc = $dist->create([force => BOOL, verbose => BOOL, keep_source => BOOL])

C<create> preps a distribution for installation. This means it will 
build a C<.deb> file of the module object you've specified from the 
meta data files that were generated during C<prepare>.

Returns true on success and false on failure.

You may then call C<< $deb->install >> on the object to actually
install it.
Returns the location of the C<.deb> file on success, and false on failure.

=cut

sub create {
    ### just in case you already did a create call for this module object
    ### just via a different dist object
    my $dist = shift;
    my $self = $dist->parent;
    $dist    = $self->status->dist   if      $self->status->dist;
    $self->status->dist( $dist )     unless  $self->status->dist;

    my $cb   = $self->parent;
    my $conf = $cb->configure_object;
    my %hash = @_;

    my $args;
    my( $verbose,$force,$keep_source);
    {   local $Params::Check::ALLOW_UNKNOWN = 1;
        my $tmpl = {
            verbose     => { default => $conf->get_conf('verbose'),
                                store => \$verbose },
            force       => { default => $conf->get_conf('force'),
                                store => \$force },
            keep_source => { default => undef, store => \$keep_source },                                
        };

        $args = check( $tmpl, \%hash ) or return;
    }
    
    ### did you prepare it yet?
    unless( $dist->status->prepared ) {
        error( loc( "You have not successfully prepared a '%2' distribution ".
                    "yet -- cannot create yet", __PACKAGE__ ) );
        return;
    }
    
    ### already created? 
    if( $dist->status->created and not $force ) {
        msg(loc("You have already created a '%1' distribution -- not doing ".