File Coverage

blib/lib/OpenInteract2/Manage.pm

Criterion	Covered	Total	%
statement	6	6	100.0
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	8	8	100.0

package OpenInteract2::Manage;

# $Id: Manage.pm,v 1.49 2005/03/17 14:57:58 sjn Exp $

use strict;
use base qw( Exporter OpenInteract2::ParamContainer Class::Factory Class::Observable );
use Cwd                      qw( cwd );
use File::Spec::Functions    qw( :ALL );
use Log::Log4perl            qw( get_logger :levels );
use OpenInteract2::Constants qw( :log );
use OpenInteract2::Context   qw( CTX );
use OpenInteract2::Exception qw( oi_error oi_param_error );
use OpenInteract2::Setup;

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

my $SYSTEM_PACKAGES = [
    qw/ base       base_box        base_error    base_group
        base_page  base_security   base_template base_theme
        base_user  comments        full_text     news
        lookup     object_activity system_doc    whats_new /
];

sub SYSTEM_PACKAGES { return $SYSTEM_PACKAGES }

my %PACKAGE_GROUPS = (
    SYSTEM => $SYSTEM_PACKAGES,
);

use constant DEV_LIST  => '[e-mail]';
use constant HELP_LIST => '[e-mail]';

@OpenInteract2::Manage::EXPORT_OK = qw(
          SYSTEM_PACKAGES DEV_LIST HELP_LIST
);

########################################
# MAIN EXTERNAL INTERFACE

sub new {
    my ( $pkg, $task_name, $params, @extra ) = @_;
    my $class = $pkg->get_factory_class( $task_name );
    my $self = bless( { _status => [] }, $class );

    if ( ref $params eq 'HASH' ) {
        while ( my ( $name, $value ) = each %{ $params } ) {
            $self->param( $name => $value );
        }
    }

    # Check for defaults

    my $param_metadata = $self->get_parameters;
    foreach my $name ( keys %{ $param_metadata } ) {
        next if ( $self->param( $name ) );
        next unless ( $param_metadata->{ $name }{default} );
        $self->param( $name => $param_metadata->{ $name }{default} );
    }

    $self->init( @extra );
    return $self;
}

sub execute {
    my ( $self ) = @_;
    $self->check_parameters;
    $self->setup_task;

    # Track our current directory so the task can feel free to do what
    # it wants

    my $pwd = rel2abs( curdir );

    $self->notify_observers( progress => 'Starting task' );

    eval { $self->run_task };
    my $error = $@;
    if ( $error ) {
        $self->notify_observers( progress => 'Failed task' );
        $self->param( task_failed => 'yes' );
        $self->param( task_error  => "$error" );
    }
    $self->tear_down_task;
    chdir( $pwd );
    if ( $error ) {
        oi_error $error;
    }
    $self->notify_observers( progress => 'Task complete' );
    return $self->get_status;
}


########################################
# STANDARD PARAMETER DESCRIPTIONS AND DESCRIPTORS

sub get_param_description {
    my ( $self, $param_name ) = @_;
    if ( $param_name eq 'source_dir' ) {
        return "OpenInteract2 source directory, or at least a directory with " .
               "the 'pkg/' and 'sample/' directories from the distribution.";
    }
    elsif ( $param_name eq 'website_dir' ) {
        return "Functional OpenInteract2 website directory";
    }
    elsif ( $param_name eq 'package_list_file' ) {
        return "Filename with packages to process, one per line";
    }
    elsif ( $param_name eq 'package' ) {
        return "One or more packages to process";
    }
    return 'no description available';
}

sub _get_source_dir_param {
    my ( $self ) = @_;
    return {
        description => $self->get_param_description( 'source_dir' ),
        is_required => 'yes',
        default     => cwd(),
    }
}

########################################
# PARAMETER CHECKING

# Wrapper for all check methods

sub check_parameters {
    my ( $self ) = @_;
    $self->_init_setup_packages;
    $self->param_initialize();
    my $params = $self->get_parameters();

    # First check parameters that are required

    my @field_notfound = ();
    while ( my ( $name, $info ) = each %{ $params } ) {
        next unless ( $info->{is_required} eq 'yes' );
        unless ( $self->param( $name ) ) {
            push @field_notfound, $name;
        }
    }
    if ( scalar @field_notfound ) {
        my %err = map { $_ => 'Required parameter not defined' }
                      @field_notfound;
        oi_param_error "A value for one or more required parameters ",
                       "was not found.",
                       { parameter_fail => \%err };
    }

    # Now do validatable parameters

    my %field_invalid = ();
    while ( my ( $name, $info ) = each %{ $params } ) {
        my $do_validate = ( ( defined $info->{is_required} and $info->{is_required} eq 'yes' ) ||
                            ( defined $info->{do_validate} and $info->{do_validate} eq 'yes' ) );
        next unless ( $do_validate );
        my $value = $self->param( $name );
        my @errors = grep { defined $_ } $self->validate_param( $name, $value );
        if ( scalar @errors ) {
            $field_invalid{ $name } = \@errors
        }
    }

    if ( scalar keys %field_invalid ) {
        oi_param_error "One or more parameters failed a validity check",
                       { parameter_fail => \%field_invalid };
    }
}


# Validate the given parameter -- these are built-in for everyone to
# use

sub validate_param {
    my ( $self, $param_name, $value ) = @_;
    if ( $param_name eq 'source_dir' ) {
        return $self->_check_source_dir( $value );
    }
    elsif ( $param_name eq 'website_dir' ) {
        unless ( -d $value ) {
            return "Value for 'website_dir' ($value) must be a " .
                   "valid directory";
        }
    }
    elsif ( $param_name eq 'package_file' ) {
        unless ( -f $value ) {
            return "Value for 'package_file' ($value) must specify " .
                   "a valid file";
        }
    }
    return undef;
}

sub _check_source_dir {
    my ( $self, $source_dir ) = @_;
    unless ( -d $source_dir ) {
        return "Value for 'source_dir' ($source_dir) is not a valid directory";
    }
    foreach my $distrib_dir ( qw( pkg sample ) ) {
        my $full_distrib_dir = catdir( $source_dir, $distrib_dir );
        unless ( -d $full_distrib_dir ) {
            return "The 'source_dir' must contain valid subdirectory " .
                   "[$distrib_dir]";
        }
    }
    return;
}


########################################
# PARAMETER INITIALIZATION

# If package exist, reads in the SYSTEM value, the
# package_list_file, etc.

sub _init_setup_packages {
    my ( $self ) = @_;
    my $initial_packages = $self->param( 'package' );
    return unless ( $initial_packages );
    if ( ref $initial_packages ne 'ARRAY' ) {
        $self->param( package => [ $initial_packages ] );
    }
    $self->_init_setup_comma_packages;
    $self->_init_setup_package_groups;
    $self->_init_read_packages_from_file;

    # Remove dupes

    my $packages = $self->param( 'package' );
    if ( ref $packages eq 'ARRAY' ) {
        my %names = map { $_ => 1 } @{ $packages };
        $self->param( package => [ sort keys %names ] );
    }
}

# allows --package=x,y --package=z to be combined; assumes 'package'
# param is already an arrayref

sub _init_setup_comma_packages {
    my ( $self ) = @_;
    my $packages = $self->param( 'package' );
    $self->param( package => [ split( /\s*,\s*/, join( ',', @{ $packages } ) ) ] );
}


# Allow a special keyword for users to specify all the initial (base)
# packages. This allows something like:
#
#   oi_manage --package=SYSTEM ...
#   oi_manage --package=SYSTEM,mypkg,theirpkg ...
#
# and the keyword 'SYSTEM' will be replaced by all the system
# packages, which can be found by doing 'oi2_manage system_packages';
# assumes 'package' param is already an arrayref

sub _init_setup_package_groups {
    my ( $self ) = @_;
    my $packages = $self->param( 'package' );
    return unless ( ref $packages eq 'ARRAY' );
    my %pkg_names = map { $_ => 1 } @{ $packages };
    foreach my $group_key ( keys %PACKAGE_GROUPS ) {
        if ( exists $pkg_names{ $group_key } ) {
            $pkg_names{ $_ }++ for ( @{ $PACKAGE_GROUPS{ $group_key } } );
            delete $pkg_names{ $group_key };
        }
    }
    $self->param( package => [ sort keys %pkg_names ] )
}

# assumes 'package' param is already an arrayref

sub _init_read_packages_from_file {
    my ( $self ) = @_;
    my $filename = $self->param( 'package_list_file' );
    return unless ( $filename );
    unless ( -f $filename ) {
        oi_error "Failure reading package list file [$filename]: ",
                 "file does not exist";
    }
    eval { open( PKG, '<', $filename ) || die $! };
    if ( $@ ) {
        oi_error "Failure reading package list file [$filename]: $@";
    }
    my @read_packages = ();
    while (  ) {
        chomp;
        next if /^\s*\#/;
        next if /^\s*$/;
        s/^\s+//;
        s/\s+$//;
        push @read_packages, $_;
    }
    close( PKG );

    # They can also specify --package, so add those too -- don't worry
    # about dupes, they get weeded out later

    $self->param( package => [ @read_packages,
                               @{ $self->param( 'package' ) } ] );
}


########################################
# TASK LIST/CHECK

sub is_valid_task {
    my ( $class, $task_name ) = @_;
    my %tasks = map { $_ => 1 } $class->valid_tasks;
    return ( defined $tasks{ $task_name } );
}

sub valid_tasks {
    return __PACKAGE__->get_registered_types;
}

sub valid_tasks_description {
    my ( $self ) = @_;
    my %tasks = map { $_ => 1 } $self->valid_tasks;
    foreach my $task ( keys %tasks ) {
        my $task_class = $self->get_factory_class( $task );
        my $desc  = $task_class->get_brief_description;
        $tasks{ $task } = $desc;
    }
    return \%tasks;
}

# Retrieves the parameter hashref for a particular task -- this can be
# a class method (needs $task_name filled in) or an object method

sub task_parameters {
    my ( $item, $task_name ) = @_;
    my ( $manage );
    if ( ref $item ) {
        $manage = $item;
    }
    else {
        unless ( $task_name ) {
            oi_error "If you call 'task_parameters' as a class method ",
                     "you must pass the task name as the only argument.";
        }
        $manage = $item->new( $task_name );
    }
    my $params = $manage->get_parameters;
    my %basic_params = ();
    while ( my ( $name, $info ) = each %{ $params } ) {
        $info->{name} = $name;
        $basic_params{ $name } = $info;
    }
    return \%basic_params;
}

# Retrieves all parameter names plus whether they're
# boolean/multivalued

sub all_parameters {
    my ( $class ) = @_;
    my %all = ();
    foreach my $task_name ( $class->valid_tasks ) {
        my $param_data = $class->task_parameters( $task_name );
        next unless ( ref $param_data eq 'HASH' );
        while ( my ( $name, $info ) = each %{ $param_data } ) {
            next if ( $all{ $name } );
            $all{ $name } = $info;
        }
    }
    return \%all;
}



sub all_parameters_long_options {
    my ( $class ) = @_;
    my $all_params = $class->all_parameters;
    my @opt = ();
    while ( my ( $name, $info ) = each %{ $all_params } ) {
        if ( defined $info->{is_boolean} and
             $info->{is_boolean} eq 'yes' ) {
            push @opt, $name;
        }
        elsif ( defined $info->{is_multivalued} and
                $info->{is_multivalued} eq 'yes' ) {
            push @opt, "$name=s@";
        }
        else {
            push @opt, "$name=s";
        }
    }
    return @opt;
}

########################################
# PARAMETERS

sub param_copy_from {
    my ( $self, $other_task ) = @_;
    $self->param_assign( $other_task->param );
    return $self->param;
}


########################################
# STATUS

sub _add_status {
    my ( $self, @status ) = @_;
    push @{ $self->{_status} }, @status;
    foreach my $hr ( @status ) {
        $self->notify_observers( status => $hr );
    }
    return $self->{_status};
}

sub _add_status_head {
    my ( $self, @status ) = @_;
    unshift @{ $self->{_status} }, @status;
    foreach my $hr ( @status ) {
        $self->notify_observers( status => $hr );
    }
    return $self->{_status};
}

sub get_status {
    my ( $self ) = @_;
    return @{ $self->{_status} };
}

sub merge_status_by_action {
    my ( $item, @status ) = @_;
    if ( scalar @status == 0
         and UNIVERSAL::isa( $item, 'OpenInteract2::Manage' ) ) {
        @status = $item->get_status;
    }
    my $current_action = '';
    my @tmp_status = ();
    my @new_status = ();
    foreach my $s ( @status ) {
        unless ( $current_action ) {
            $current_action = $s->{action};
        }
        if ( defined $s->{action} and $s->{action} ne $current_action ) {
            push @new_status, { action => $current_action,
                                status => [ @tmp_status ] };
            @tmp_status = ();
            $current_action = $s->{action};
        }
        push @tmp_status, $s;
    }
    if ( scalar @tmp_status > 0 ) {
        push @new_status, { action => $current_action,
                            status => \@tmp_status };
    }
    return @new_status;
}

# shortcut for adding bad/good status

sub _fail {
    my ( $self, $action, $msg, %additional ) = @_;
    $self->_add_status({
        is_ok    => 'no',
        action   => $action,
        message  => $msg,
        %additional,
    });
    return;
}

sub _ok {
    my ( $self, $action, $msg, %additional ) = @_;
    $self->_add_status({
        is_ok    => 'yes',
        action   => $action,
        message  => $msg,
        %additional,
    });
    return;
}



########################################
# INFRASTRUCTURE (SUBCLASSES)

sub _setup_context {
    my ( $self, $params ) = @_;

    # don't recreate the context every time
    eval { OpenInteract2::Context->instance };
    return unless ( $@ );

    my $log = get_logger();
    if ( $self->param( 'debug' ) ) {
        $log->level( $DEBUG );
    }
    my $website_dir = $self->param( 'website_dir' );
    unless ( -d $website_dir ) {
        oi_error "Cannot open context with invalid website ",
                 "directory '$website_dir'";
    }
    $log->info( "Website directory '$website_dir' exists, setting up context..." );
    my $bootstrap = OpenInteract2::Config::Bootstrap->new({
        website_dir => $website_dir
    });
    $log->info( "Created bootstrap config ok, creating context..." );
    OpenInteract2::Context->create( $bootstrap, $params );
    $log->info( "Context setup for management task(s) ok" );
}

# Creates status entry with all files removed/skipped/updated

sub _set_copy_file_status {
    my ( $self, $status ) = @_;
    $status->{copied}  ||= [];
    $status->{skipped} ||= [];
    $status->{same}    ||= [];
    foreach my $file ( @{ $status->{copied} } ) {
        $self->_ok(
            'copy updated template files',
            "File $file copied",
            filename => $file
        );
    }
    foreach my $file ( @{ $status->{skipped} } ) {
        $self->_ok(
            'copy updated template files',
            "File $file skipped, marked as read-only",
            filename => $file
        );
    }
    foreach my $file ( @{ $status->{same} } ) {
        $self->_ok(
            'copy updated template files',
            "File $file skipped, source and destination same",
            filename => $file
        );
    }
}

########################################
# FACTORY

sub factory_log {
# no-op so we get around the l4p 'no init' msg
#    my ( $self, @msg ) = @_;
#    get_logger()->info( @msg );
}

sub factory_error {
    my ( $self, @msg ) = @_;
    get_logger()->error( @msg );
    die @msg, "\n";
}


##############################
# FIND ALL MANAGEMENT TASKS

OpenInteract2::Util->find_factory_subclasses(
    'OpenInteract2::Manage', @INC
);


########################################
# INTERFACE
# All are optional except run_task()

# Run at new()
sub init                  {}

# Identify the name by which your task is known
sub get_name              { return undef }

# Help out tools using your task and describe what it does
sub get_brief_description { return 'No description available' }

# Return parameter information
sub get_parameters        { return {} }

# Do the work!
sub run_task              { die "Define run_task() in subclass" }

# Do work before run_task()
sub setup_task            { return undef }

# Do cleanup after run_task()
sub tear_down_task        { return undef }

# Do pre-validation transformations of parameters
sub param_initialize      { return undef }

1;

__END__