[svn:mod_parrot] r337 - in mod_parrot/branches/configure: config/directives lib/ModParrot lib/ModParrot/Configure

Author: particle
Date: Sat May 17 17:53:18 2008
New Revision: 337

Added:
   mod_parrot/branches/configure/lib/ModParrot/Configure.pm
   mod_parrot/branches/configure/lib/ModParrot/Configure/Data.pm
Modified:
   mod_parrot/branches/configure/config/directives/configure.op
   mod_parrot/branches/configure/lib/ModParrot/Configure/Messages.pm

Log:
[config] create/init configure objects, ready to write and perform configure tasks

Modified: mod_parrot/branches/configure/config/directives/configure.op
==============================================================================
--- mod_parrot/branches/configure/config/directives/configure.op	(original)
+++ mod_parrot/branches/configure/config/directives/configure.op	Sat May 17 17:53:18 2008
@@ -11,11 +11,11 @@
 ## print the intro
 introduction
 
-### TODO do we really want this here, or should it exist by default?
-#configure_new
-#configure_set_args
-#
-### run the configuration steps
+## TODO do we really want this here, or should it exist by default?
+configure_new
+configure_set_args
+
+## run the configuration steps
 #run init::manifest
 #run init::defaults
 #run init::install

Added: mod_parrot/branches/configure/lib/ModParrot/Configure.pm
==============================================================================
--- (empty file)
+++ mod_parrot/branches/configure/lib/ModParrot/Configure.pm	Sat May 17 17:53:18 2008
@@ -0,0 +1,308 @@
+# Copyright (C) 2008, Jeff Horwitz.
+# $Id$
+
+=head1 NAME
+
+ModParrot::Configure - Conducts the execution of Configuration Steps
+
+=head1 SYNOPSIS
+
+    use ModParrot::Configure;
+
+    my $conf = ModParrot::Configure->new;
+    my $data = $conf->data;
+    my $options = $conf->options;
+    my @steps = $conf->steps;
+    $conf->add_steps(@steps);
+    $conf->runsteps;
+
+=head1 DESCRIPTION
+
+This module provides provides a means for registering, executing, and
+coordinating one or more Configuration steps.  Please see
+F<docs/configuration.pod> for further details about the configuration
+framework.
+
+=cut
+
+package ModParrot::Configure;
+
+use strict;
+use warnings;
+
+use lib qw(config);
+use Carp qw(carp);
+use ModParrot::Configure::Data;
+
+use Class::Struct;
+
+struct(
+    'ModParrot::Configure::Task' => {
+        step   => '$',
+        params => '@',
+        object => 'ModParrot::Configure::Step',
+    },
+);
+
+
+=head2 Methods
+
+=over 4
+
+=item * C<new()>
+
+Basic constructor. Returns a L<ModParrot::Configure> object.
+
+=cut
+
+my $singleton;
+BEGIN {
+    $singleton = {
+        steps   => [],
+        data    => ModParrot::Configure::Data->new,
+        options => ModParrot::Configure::Data->new,
+    };
+    bless $singleton, "ModParrot::Configure";
+}
+
+sub new {
+    my $class = shift;
+    return $singleton;
+}
+
+
+=item * C<data()>
+
+Provides access to a L<ModParrot::Configure::Data> object intended to contain
+initial and discovered configuration data.
+
+Accepts no arguments and returns a L<ModParrot::Configure::Data> object.
+
+=cut
+
+sub data {
+    my $self = shift;
+
+    return $self->{data};
+}
+
+
+=item * C<options()>
+
+Provides access to a L<ModParrot::Configure::Data> object intended to contain CLI
+option data.
+
+Accepts no arguments and returns a L<ModParrot::Configure::Data> object.
+
+=cut
+
+sub options {
+    my $self = shift;
+
+    return $self->{options};
+}
+
+
+=item * C<steps()>
+
+Provides a list of registered steps, where each step is represented by an
+L<ModParrot::Configure::Task> object.  Steps are returned in the order in which
+they were registered in.
+
+Accepts no arguments and returns a list in list context or an arrayref in
+scalar context.
+
+=cut
+
+sub steps {
+    my $self = shift;
+
+    return wantarray ? @{ $self->{steps} } : $self->{steps};
+}
+
+=item * C<add_step()>
+
+Registers a new step and any parameters that should be passed to it.  The
+first parameter passed is the class name of the step being registered.  All
+other parameters are saved and passed to the registered class's C<runstep()>
+method.
+
+Accepts a list and modifies the data structure within the L<ModParrot::Configure> object.
+
+=cut
+
+
+sub add_step {
+    my ( $self, $step, @params ) = @_;
+
+    push @{ $self->{steps} }, ModParrot::Configure::Task->new( step => $step, params => \@params );
+
+    return 1;
+}
+
+
+=item * C<add_steps()>
+
+Registers new steps to be run at the end of the execution queue.
+
+Accepts a list of new steps and modifies the data structure within the L<ModParrot::Configure> object.
+
+=cut
+
+sub add_steps {
+    my ( $self, @new_steps ) = @_;
+
+    foreach my $step (@new_steps) {
+        $self->add_step($step);
+    }
+
+    return 1;
+}
+
+
+=item * C<runsteps()>
+
+Sequentially executes steps in the order they were registered.  The invoking
+L<ModParrot::Configure> object is passed as the first argument to each step's
+C<runstep()> method, followed by any parameters that were registered for that
+step.
+
+Accepts no arguments and modifies the data structure within the L<ModParrot::Configure> object.
+
+=cut
+
+sub runsteps {
+    my $self = shift;
+
+    my ( $verbose, $verbose_step, $ask ) = $self->options->get(qw(verbose verbose-step ask));
+
+    my $n = 0;    # step number
+    foreach my $task ( $self->steps ) {
+        $n++;
+        $self->_runstep( $task, $verbose, $verbose_step, $ask, $n );
+    }
+    return 1;
+}
+
+
+=item * C<runstep()>
+
+The invoking L<ModParrot::Configure> object is passed as the first argument to
+each step's C<runstep()> method, followed by any parameters that were
+registered for that step.
+
+Accepts no arguments and modifies the data structure within the L<ModParrot::Configure> object.
+
+=cut
+
+sub runstep {
+    my $self     = shift;
+    my $taskname = shift;
+
+    my ( $verbose, $verbose_step, $ask ) = $self->options->get(qw(verbose verbose-step ask));
+
+    for my $task ( $self->steps() ) {
+#        print STDERR $task->{"ModParrot::Configure::Task::step"}, "\n"; 
+        if ( $task->{"ModParrot::Configure::Task::step"} eq $taskname ) {
+            $self->_runstep( $task, $verbose, $verbose_step, $ask, 1 );
+        }
+    }
+}
+
+
+sub _runstep {
+    my $self = shift;
+    my $task = shift;
+
+    my ( $verbose, $verbose_step, $ask, $n ) = @_;
+
+    my $step_name   = $task->step;
+    my @step_params = @{ $task->params };
+
+    eval "use $step_name;";
+    die $@ if $@;
+
+    my $step = $step_name->new;
+
+    # XXX This works. but is probably not a good design.
+    # Using $step->description() would be nicer
+    my $description = $step->description();
+    $description = "" unless defined $description;
+
+    # set per step verbosity
+    if ( defined $verbose_step ) {
+
+        # by step number
+        if ( $verbose_step =~ /^\d+$/ && $n == $verbose_step ) {
+            $self->options->set( verbose => 2 );
+        }
+
+        # by description
+        elsif ( $description =~ /$verbose_step/ ) {
+            $self->options->set( verbose => 2 );
+        }
+    }
+
+    # XXX cc_build uses this verbose setting, why?
+    $self->data->set( verbose => $verbose ) if $n > 2;
+
+    print "\n", $description, '...';
+    print "\n" if $verbose && $verbose == 2;
+
+    my $ret;    # step return value
+    eval {
+        if (@step_params)
+        {
+            $ret = $step->runstep( $self, @step_params );
+        }
+        else {
+            $ret = $step->runstep($self);
+        }
+    };
+    if ($@) {
+        carp "\nstep $step_name died during execution: $@\n";
+        return;
+    }
+
+    # did the step return itself?
+    eval { $ret->can('result'); };
+
+    # if not, report the result and return
+    if ($@) {
+        my $result = $step->result || 'no result returned';
+        carp "\nstep $step_name failed: " . $result;
+        return;
+    }
+
+    my $result = $step->result || 'done';
+
+    print "..." if $verbose && $verbose == 2;
+    print "." x ( 71 - length($description) - length($result) );
+    print "$result." unless $step =~ m{^inter/} && $ask;
+
+    # reset verbose value for the next step
+    $self->options->set( verbose => $verbose );
+}
+
+
+=back
+
+=head1 CREDITS
+
+The L</runsteps()> method is largely based on code written by Brent
+Royal-Gordon C<[email protected]>.
+
+=head1 AUTHOR
+
+Joshua Hoblitt C<[email protected]>
+
+=head1 SEE ALSO
+
+F<docs/configuration.pod>, L<ModParrot::Configure::Data>,
+L<ModParrot::Configure::Step>, L<ModParrot::Configure::Step::Base>
+
+=cut
+
+1;
+
+# vim: expandtab shiftwidth=4:

Added: mod_parrot/branches/configure/lib/ModParrot/Configure/Data.pm
==============================================================================
--- (empty file)
+++ mod_parrot/branches/configure/lib/ModParrot/Configure/Data.pm	Sat May 17 17:53:18 2008
@@ -0,0 +1,361 @@
+# Copyright (C) 2008, Jeff Horwitz.
+# $Id$
+
+=pod
+
+=head1 NAME
+
+ModParrot::Configure::Data - Configuration data container
+
+=head1 SYNOPSIS
+
+    use ModParrot::Configure::Data;
+
+    my $data = ModParrot::Configure::Data->new;
+    my @values = $data->get(@keys);
+    $data->set($key1 => $value1, $key2 => $value2);
+    $data->add($delimiter, $key1 => $value1, $key2 => $value2);
+    my @keys = $data->keys;
+    my $serialized = $data->dump;
+    $data->clean;
+    $data->settrigger($key, $trigger, $cb);
+    $data->gettriggers($key);
+    $data->gettrigger($key, $trigger);
+    $data->deltrigger($key, $trigger);
+
+=head1 DESCRIPTION
+
+This module contains configuration data for use by the other
+L<ModParrot::Configure::*> modules.
+
+=head1 USAGE
+
+=head2 Import Parameters
+
+This module accepts no arguments to its C<import> method and exports no
+I<symbols>.
+
+=cut
+
+package ModParrot::Configure::Data;
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+
+=head2 Methods
+
+=over 4
+
+=item C<new()>
+
+Basic object constructor.
+
+Accepts no arguments and returns a L<ModParrot::Configure::Data> object.
+
+=cut
+
+sub new {
+    my $class = shift;
+
+    my $self = {
+        c        => {},
+        triggers => {},
+    };
+
+    bless $self, ref $class || $class;
+    return $self;
+}
+
+
+=item C<get($key, ...)>
+
+Provides access to key values.
+
+Accepts a list and returns a list.
+
+=cut
+
+sub get {
+    my $self = shift;
+
+    my $c = $self->{c};
+
+    return @$c{@_};
+}
+
+
+=item C<set($key => $val, ...)>
+
+Modifies or creates a new value.
+
+Accepts a list of C<< key => value >> pairs and returns a
+L<ModParrot::Configure::Data> object.
+
+=cut
+
+sub set {
+    my $self = shift;
+
+    my $verbose = defined $self->get('verbose') && $self->get('verbose') == 2;
+
+    print "Setting Configuration Data:\n(\n" if $verbose;
+
+    while ( my ( $key, $val ) = splice @_, 0, 2 ) {
+        print "\t$key => ", defined($val) ? "'$val'" : 'undef', ",\n"
+            if $verbose;
+        $self->{c}{$key} = $val;
+
+        foreach my $trigger ( $self->gettriggers($key) ) {
+            print "\tcalling trigger $trigger for $key\n" if $verbose;
+            my $cb = $self->gettrigger( $key, $trigger );
+
+            &$cb( $key, $val );
+        }
+    }
+
+    print ");\n" if $verbose;
+
+    return $self;
+}
+
+
+=item C<add($delim, $key => $val, ...)>
+
+Either creates a new key or appends to an existing key, with the previous/new
+values joined together by C<$delim>.
+
+Accepts a delimiter value followed by a list of C<< key => value >> pairs and
+returns a L<ModParrot::Configure::Data> object.
+
+=cut
+
+sub add {
+    my $self  = shift;
+    my $delim = shift;
+
+    while ( my ( $key, $val ) = splice @_, 0, 2 ) {
+        my ($old) = $self->{c}{$key};
+        if ( defined $old ) {
+            $self->set( $key, "$old$delim$val" );
+        }
+        else {
+            $self->set( $key, $val );
+        }
+    }
+
+    return $self;
+}
+
+
+=item C<keys()>
+
+Provides a list of keys.
+
+Accepts no arguments and returns a list.
+
+=cut
+
+sub keys {
+    my $self = shift;
+
+    return keys %{ $self->{c} };
+}
+
+
+=item C<slurp()>
+
+Slurps in L<ModParrot::Config> data from previous configure.
+
+Accepts no arguments.
+
+=cut
+
+sub slurp() {
+    my $self = shift;
+    my $res  = eval "no strict; use ModParrot::Config::Generated; \\%PConfig";
+
+    if ( not defined $res ) {
+        die "You cannot use --step until you have completed the full configure process\n";
+    }
+    $self->{c} = $res;
+}
+
+
+=item C<dump()>
+
+Provides a L<Data::Dumper> serialized string of the objects key/value pairs
+suitable for being C<eval>ed.  The variable name of the structure is
+C<PConfig>.
+
+Accepts no arguments and returns a string.
+
+=cut
+
+# Data::Dumper supports Sortkeys since 2.12
+# older versions will work but obviously not sorted
+{
+    my $dd_version;
+    if ( $Data::Dumper::VERSION =~ /([\d.]+)/ ) {
+        $dd_version = $1;
+    }
+    else {
+        $dd_version = $Data::Dumper::VERSION;
+    }
+
+    if ( $dd_version >= 2.12 ) {
+        *dump = sub {
+            my $self = shift;
+            Data::Dumper->new( [ $self->{c} ], ['*PConfig'] )->Sortkeys(1)->Dump();
+        };
+    }
+    else {
+        *dump = sub {
+            my $self = shift;
+            Data::Dumper->new( [ $self->{c} ], ['*PConfig'] )->Dump();
+        };
+    }
+}
+
+
+=item C<clean()>
+
+Deletes keys matching C</^TEMP_/>.  Keys using this naming convention are
+intended to be used only temporally, e.g.  as file lists for Makefile
+generation.
+
+Accepts no arguments and returns a L<ModParrot::Configure::Data> object.
+
+=cut
+
+sub clean {
+    my $self = shift;
+
+    delete $self->{c}{$_} for grep { /^TEMP_/ } CORE::keys %{ $self->{c} };
+
+    return $self;
+}
+
+
+=item C<settrigger($key, $trigger, $cb)>
+
+Set a callback on C<$key> named C<$trigger>.  Multiple triggers can be set on a
+given key.  When the key is set via C<set> or C<add> then all callbacks that
+are defined will be called.  Triggers are passed the key and value that was set
+after it has been changed.
+
+Accepts a key name, a trigger name, & a C<CODE> ref and returns a
+L<ModParrot::Configure::Data> object.
+
+=cut
+
+sub settrigger {
+    my ( $self, $key, $trigger, $cb ) = @_;
+
+    return unless defined $key and defined $trigger and defined $cb;
+
+    my $verbose = defined $self->get('verbose') && $self->get('verbose') == 2;
+
+    print "Setting trigger $trigger on configuration key $key\n",
+        if $verbose;
+
+    $self->{triggers}{$key}{$trigger} = $cb;
+
+    return $self;
+}
+
+
+=item C<gettriggers($key)>
+
+Get the names of all triggers set for C<$key>.
+
+Accepts a key name and returns a list.
+
+=cut
+
+sub gettriggers {
+    my ( $self, $key ) = @_;
+
+    return unless defined $self->{triggers}{$key};
+
+    my $verbose = defined $self->get('verbose') && $self->get('verbose') == 2;
+
+    print "Looking up all triggers on configuration key $key\n"
+        if $verbose;
+
+    return CORE::keys %{ $self->{triggers}{$key} };
+}
+
+
+=item C<gettrigger($key, $trigger)>
+
+Get the callback set for C<$key> under the name C<$trigger>
+
+Accepts a key name & a trigger name and returns a C<CODE> ref.
+
+=cut
+
+sub gettrigger {
+    my ( $self, $key, $trigger ) = @_;
+
+    return
+        unless defined $self->{triggers}{$key}
+        and defined $self->{triggers}{$key}{$trigger};
+
+    my $verbose = defined $self->get('verbose') && $self->get('verbose') == 2;
+
+    print "Looking up trigger $trigger on configuration key $key\n"
+        if $verbose;
+
+    return $self->{triggers}{$key}{$trigger};
+}
+
+
+=item C<deltrigger($key, $trigger)>
+
+Removes the trigger on C<$key> named by C<$trigger>
+
+Accepts a key name & a trigger name and returns a L<ModParrot::Configure::Data>
+object.
+
+=cut
+
+sub deltrigger {
+    my ( $self, $key, $trigger ) = @_;
+
+    return
+        unless defined $self->{triggers}{$key}
+        and defined $self->{triggers}{$key}{$trigger};
+
+    my $verbose = defined $self->get('verbose') && $self->get('verbose') == 2;
+
+    print "Removing trigger $trigger on configuration key $key\n"
+        if $verbose;
+
+    delete $self->{triggers}{$key}{$trigger};
+
+    return $self;
+}
+
+
+=back
+
+=head1 CREDITS
+
+Based largely on code written by Brent Royal-Gordon C<[email protected]>.
+
+=head1 AUTHOR
+
+Joshua Hoblitt C<[email protected]>
+
+=head1 SEE ALSO
+
+F<docs/configuration.pod>, L<ModParrot::Configure>, L<ModParrot::Configure::Step>,
+L<ModParrot::Configure::Step::Base>
+
+=cut
+
+1;
+
+# vim: expandtab shiftwidth=4:

Modified: mod_parrot/branches/configure/lib/ModParrot/Configure/Messages.pm
==============================================================================
--- mod_parrot/branches/configure/lib/ModParrot/Configure/Messages.pm	(original)
+++ mod_parrot/branches/configure/lib/ModParrot/Configure/Messages.pm	Sat May 17 17:53:18 2008
@@ -42,9 +42,9 @@
 Copyright (C) 2008, Jeff Horwitz.
 
 Hello, I'm Configure. My job is to poke and prod your system to figure out
-how to build mod_parrot. The process is completely automated, unless you passed in
-the `--ask' flag on the command line, in which case it'll prompt you for a few
-pieces of info.
+how to build mod_parrot. The process is completely automated, unless you
+passed in the "--ask" flag on the command line, in which case you will be
+prompted for a few pieces of info.
 INTRODUCTION
 }