openinteract-commits

[Chris W. <la...@us...>]

Update of /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2/Manage/Package
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28131/lib/OpenInteract2/Manage/Package

Added Files:
	CreateCPAN.pm 
Log Message:
OIN-72: add new management task to create CPAN-distributable tarball


--- NEW FILE: CreateCPAN.pm ---
package OpenInteract2::Manage::Package::CreateCPAN;

# $Id: CreateCPAN.pm,v 1.1 2005/02/08 01:37:18 lachoy Exp $

use strict;
use base qw( OpenInteract2::Manage::Package );
use Cwd                      qw( cwd );
use ExtUtils::Manifest;
use File::Basename           qw( dirname );
use File::Copy               qw( cp );
use File::Path               qw( mkpath rmtree );
use File::Spec::Functions    qw( catfile );
use Log::Log4perl            qw( get_logger );
use MIME::Base64             qw( encode_base64 );
use OpenInteract2::Constants qw( :log );
use OpenInteract2::Context   qw( CTX );
use OpenInteract2::Exception qw( oi_error );

$OpenInteract2::Manage::Package::CreateCPAN::VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);

my @BINARIES = qw( gz zip gif png jpg ico pdf doc );
my $DIST_DIR = "tmp-build-cpan";

sub get_name {
    return 'create_cpan';
}

sub get_brief_description {
    return 'Create a CPAN distribution from your package.';
}

sub get_parameters {
    my ( $self ) = @_;
    return {
       package_dir => {
         description => q{Directory of package to export (default: pwd)},
         default     => cwd(),
         is_required => 'yes',
       },
       make_bin => {
           description => q{Binary for your "make" implementation (default: 'make')},
           default     => 'make',
           is_required => 'yes',
       },
       keep_dir => {
           description => q{If set to "yes" we keep the generated CPAN directory (default: 'no')},
           default     => 'no',
           is_required => 'yes',
       },
    };
}

sub validate_param {
    my ( $self, $name, $value ) = @_;
    if ( $name eq 'package_dir' ) {
        return $self->_check_package_dir( $value );
    }
    return $self->SUPER::validate_param( $name, $value );
}

sub tear_down_task {
    my ( $self ) = @_;
    my $keep_dir = lc $self->param( 'keep_dir' );
    if ( -d $DIST_DIR && $keep_dir ne 'yes' ) {
        rmtree( $DIST_DIR );
    }
}

sub run_task {
    my ( $self ) = @_;
    my $package_dir = $self->param( 'package_dir' );
    my $package = OpenInteract2::Package->new({
        directory => $package_dir
    });

    my $subclass_name    = $package->name_as_class;
    my $app_class_name   = "OpenInteract2::App::$subclass_name";
    my $brick_class_name = "OpenInteract2::Brick::$subclass_name";

    my $config  = $package->config;
    my $modules = $config->module || [];

    my @author_names  = join( ', ', $config->author_names );
    my @author_emails = join( ', ', $config->author_emails );
    my ( @authors );
    for ( 0..scalar @author_names ) {
        push @authors, {
            name  => $author_names[$_],
            email => $author_emails[$_]
        };
    }

    $self->_create_dist_dir();

    my $module_file_specs = $package->get_module_files;
    my @module_files = map { join( '/', @{ $_ } ) } @{ $module_file_specs };
    my @package_modules = $self->_copy_package_modules(
        $package, \@module_files
    );
    my @brick_files = $self->_read_files_for_brick(
        $package, \@module_files
    );

    my %replacements = (
        package_name     => $package->name,
        brick_name       => $package->name,
        full_app_class   => $app_class_name,
        full_brick_class => $brick_class_name,
        subclass         => $subclass_name,
        authors          => \@authors,
        author_names     => \@author_names,
        abstract         => $config->description,
        required_modules => $modules,
        package_modules  => \@package_modules,
        package_version  => $package->version,
        package_files    => \@brick_files,
        package_pod      => '',
    );

    my $brick = OpenInteract2::Brick->new( 'package_cpan' );
    $brick->copy_all_resources_to( $DIST_DIR, \%replacements );
    my $dist_file = $self->_create_distribution( $subclass_name );
    $self->_ok(
        'create CPAN distribution',
        'Created distribution ok',
        filename => $dist_file,
    );
}

sub _create_dist_dir {
    my ( $self ) = @_;
    if ( -d $DIST_DIR ) {
        my $num_removed = rmtree( $DIST_DIR );
        unless ( $num_removed > 0 ) {
            oi_error "Failed to remove directory '$DIST_DIR'; please ",
                     "remove manually and re-run task.";
        }
    }
    mkdir( $DIST_DIR )
        || oi_error "Cannot create temporary directory '$DIST_DIR': $!";
}

# copy modules into cpan dist dir

sub _copy_package_modules {
    my ( $self, $package, $module_files ) = @_;
    my $package_dir = $package->directory;
    my @package_modules = ();
    foreach my $file ( @{ $module_files } ) {
        my $full_src  = catfile( $package_dir, $file );
        my $full_dest = catfile( $DIST_DIR, 'lib', $file );
        my $dest_dir  = dirname( $full_dest );
        unless ( -d $dest_dir ) {
            mkpath( $dest_dir );
        }
        cp( $full_src, $full_dest )
            || oi_error "Cannot copy '$full_src' to '$full_dest': $!";
        my $module = $file;
        $module =~ s/\.pm$//;
        $module =~ s|/|::|g;
        push @package_modules, $module;
    }
    return @package_modules;
}

# copy non-modules files into brick as resources

sub _read_files_for_brick {
    my ( $self, $package, $module_files ) = @_;
    my @brick_files = ();
    my $package_dir = $package->directory;
    my %module_check = map { $_ => 1 } @{ $module_files };
    my %seen_names   = ();
    my $package_files = $package->get_files;
    foreach my $file ( @{ $package_files } ) {
        next if ( $module_check{ $file } ); # modules are separate
        my @file_pieces = split /\//, $file;
        my $brick_name = $file_pieces[-1];
        if ( $seen_names{ $brick_name } ) {
            $brick_name = join ( '_', @file_pieces );
        }
        $seen_names{ $brick_name }++;
        my $inline_name = uc( $brick_name );
        $inline_name =~ s/\W/_/g;
        push @brick_files, {
            name        => $brick_name,
            inline_name => $inline_name,
            destination => join( ' ', @file_pieces ),
            evaluate    => 'no',
            contents    => $self->_read_package_file_contents( $package_dir, $file ),
        };
    }
    return @brick_files;
}

sub _read_package_file_contents {
    my ( $self, $package_dir, $file ) = @_;
    my $full_path = catfile( $package_dir, $file );
    my $binary_pat = join( '|', @BINARIES );
    if ( $full_path =~ /$binary_pat$/ ) {
        open( IN, '<', $full_path )
            || oi_error "Cannot read '$full_path': $!";
        my @content = ();
        my ( $buf );
        while ( read( IN, $buf, 60*57 ) ) {
            push @content, encode_base64( $buf );
        }
        return join( ', ', @content );
    }
    else {
        return OpenInteract2::Util->read_file( $full_path );
    }
}

sub _create_distribution {
    my ( $self, $subclass_name ) = @_;
    chdir( $DIST_DIR );

    ExtUtils::Manifest::mkmanifest();

    my ( $dist_file );
    eval {
        do './Makefile.PL';
        my $make_cmd = $self->param( 'make_bin' );
        system( $make_cmd, 'dist' );
        opendir( ARCHIVE, '.' )
            || die "Cannot open current directory for reading: $!\n";
        ( $dist_file ) = grep /$subclass_name/, grep /\.tar\.gz$/, readdir( ARCHIVE );
        closedir( ARCHIVE );
        rename( $dist_file, catfile( '..', $dist_file ) )
            || die "Cannot move archive: $!\n";
        chdir( '..' );
    };
    if ( $@ ) {
        chdir( '..' );
        oi_error( $@ );
    }
    return $dist_file;
}

OpenInteract2::Manage->register_factory_type( get_name() => __PACKAGE__ );

1;

__END__

=head1 NAME

OpenInteract2::Manage::Package::CreateCPAN - Create a CPAN distribution from a package

=head1 SYNOPSIS

 # From command-line:
 
 $ oi2_manage create_cpan
 
 # Programmatically:
 
 #!/usr/bin/perl
 
 use strict;
 use OpenInteract2::Manage;
 
 my $website_dir = '/home/httpd/mysite';
 my %PARAMS = ( package_dir = '/path/to/my/package' );
 my $task = OpenInteract2::Manage->new(
                      'create_cpan', \%PARAMS );
 my @status = $task->execute;
 foreach my $s ( @status ) {
     my $ok_label      = ( $s->{is_ok} eq 'yes' )
                           ? 'OK' : 'NOT OK';
     print "Status? $ok_label\n",
           "$s->{message}\n";
 }

=head1 DESCRIPTION

This task creates a CPAN distribution from your package contents and
metadata. You should be able to send the generated distribution to
anyone else for them to run the standard install:

 perl Makefile.PL
 make
 make test
 make install

For installing directly to a webserver you can do:

 perl Makefile.PL WEBSITE_DIR=/path/to/mysite
 make
 make test
 make install

And the files will be copied to the right place.

=head1 OPTIONS

=head2 Required

=over 4

=item B<package_dir>=/path/to/package

Path to your package; defaults to current directory if not given.

=item B<make_bin>=nmake

Name of your 'make' command; defaults to 'make' if not given.

=back

=head2 Optional

=over 4

=item B<keep_dir>=yes/no

Whether to keep the directory we use to create the CPAN package;
defaults to 'no'.

=back

=head1 STATUS INFORMATION

Includes no additional status information.

=head1 COPYRIGHT

Copyright (C) 2005 Chris Winters. All rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHORS

Chris Winters, E<lt>ch...@cw...E<gt>