Author: particle
Date: Wed Jun 13 07:10:19 2007
New Revision: 18968
Added:
branches/reconfigure/config/directives/
branches/reconfigure/config/directives/configure.op
branches/reconfigure/config/directives/core.op
branches/reconfigure/config/directives/intro.op
branches/reconfigure/config/directives/io.op
Modified:
branches/reconfigure/Configure.pl
branches/reconfigure/lib/Parrot/Configure.pm
Log:
[config]: refactoring Configure.pl
~ ability to pass in script files to direct configure process
with more control than command-line options
~ ability to save different configurations (e.g. w/ & w/o icu)
~ this should also help support cross-compilation
Modified: branches/reconfigure/Configure.pl
==============================================================================
--- branches/reconfigure/Configure.pl (original)
+++ branches/reconfigure/Configure.pl Wed Jun 13 07:10:19 2007
@@ -281,83 +281,237 @@
=cut
-use 5.006_001;
+use 5.008;
use strict;
use warnings;
-use Data::Dumper;
-$Data::Dumper::Indent = 1;
+
+use Carp;
+use Data::Dumper; $Data::Dumper::Indent = 1;
+
+use File::Basename qw( basename );
+use File::Spec::Functions qw( catdir catfile );
+use FindBin qw( $Bin );
+
+# used in tasks to find parrot libraries
use lib 'lib';
-use Parrot::BuildUtil;
-use Parrot::Configure;
-use Parrot::Configure::Options qw( process_options );
-use Parrot::Configure::Options::Test;
-use Parrot::Configure::Messages qw(
- print_introduction
- print_conclusion
-);
-use Parrot::Configure::Step::List qw( get_steps_list );
-
-my $parrot_version = Parrot::BuildUtil::parrot_version();
-
-$| = 1; # $OUTPUT_AUTOFLUSH = 1;
-
-# Install Option text was taken from:
-#
-# autoconf (GNU Autoconf) 2.59
-# Written by David J. MacKenzie and Akim Demaille.
-#
-# Copyright (C) 2003 Free Software Foundation, Inc.
-# This is free software; see the source for copying conditions. There is NO
-# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
-# from Parrot::Configure::Options
-my $args = process_options( {
- argv => [ @ARGV ],
- script => $0,
- parrot_version => $parrot_version,
- svnid => '$Id$',
-} );
-exit unless defined $args;
-
-my $opttest = Parrot::Configure::Options::Test->new($args);
-# configuration tests will only be run if you requested them
-# as command-line option
-$opttest->run_configure_tests();
-
-# from Parrot::Configure::Messages
-print_introduction($parrot_version);
-
-my $conf = Parrot::Configure->new;
-
-# from Parrot::Configure::Step::List
-$conf->add_steps(get_steps_list());
-
-my %args = %{$args};
-# from Parrot::Configure::Data
-$conf->options->set(%args);
-
-if ( exists $args{step} ) {
- # from Parrot::Configure::Data
- $conf->data()->slurp();
- # from Parrot::Configure
- $conf->runstep( $args{step} );
- print "\n";
-}
-else {
- # Run the actual steps
- # from Parrot::Configure
- $conf->runsteps or exit(1);
-}
-
-# build tests will only be run if you requested them
-# as command-line option
-$opttest->run_build_tests();
-# from Parrot::Configure::Messages
-print_conclusion($conf->data->get('make'));
+main( @ARGV ) unless caller;
+
+
+sub main {
+ ## data store for directory operations
+ my $dirstack= [];
+
+ ## data store
+ ## TODO should this be backed by dbm::deep or something?
+ my $DS= {
+ DIRS => $dirstack,
+ PARROT => {
+ argv => [ @ARGV ],
+ script => $0,
+ svnid => '$Id$',
+ },
+ user => {},
+ };
+
+ my $actions= {
+ include => \&read_config,
+ define => \&define_config_directive,
+ _DEFAULT_ => \&no_such_directive,
+ DUMP => sub{ print Dumper [EMAIL PROTECTED] },
+ };
+
+ my $ddir= catdir $Bin, 'config', 'directives';
+
+ ## define io commands, which operate on the directory stack
+ read_config( catfile( $ddir, 'io.op'), $actions, $dirstack );
+
+ ## define commands which operate on the data store
+ for my $f (qw/ core intro /)
+ {
+ read_config( catfile( $ddir, $f . '.op'), $actions, $DS );
+ }
+
+ ## process the list of configure directives
+ ## TODO allow the --script=s option to override this
+ read_config( catfile( $ddir, 'configure.op' ), $actions, $DS );
+}
+
+
+
+exit;
+
+
+
+sub read_config
+{
+ my( $filename, $actions, $userparam )= @_;
+ open my($CF) => $filename
+ or carp $!;
+
+ LINE: while(<$CF>)
+ {
+ chomp;
+ ## skip blank lines and comments
+ next if m/^\s*$/ || m/\s*#/;
+
+ my( $directive, $rest )= split /\s+/ => $_, 2;
+
+ ## deal with heredocs
+ ## heredoc delimeters can be any non-space chars following '<<'
+ ## and optional spaces (eg. '<< %END!' or '<<DESC')
+ $rest= read_heredoc( $CF, $1, $filename )
+ if( $rest && $rest =~ m/^<< \s* (\S*)$/x );
+
+ ## resolve the action
+ ## first try user-defined, otherwise default
+ my $action= $actions->{$directive}
+ || $actions->{_DEFAULT_};
+ if( $action )
+ {
+ $action->( $directive, $rest, $actions, $userparam );
+ }
+ else
+ {
+ die "unrecognized directive '$directive'"
+ . " at line $. of $filename; aborting";
+ }
+ }
+ return 1;
+}
+
+
+sub read_heredoc
+{
+ my( $CF, $marker, $filename )= @_;
+ my $line_num= $.;
+
+ my $rest= '';
+ while( my $buffer= <$CF>)
+ {
+ die "runaway heredoc on line $line_num of $filename; aborting"
+ unless defined $buffer;
+ last if $buffer =~ m/^$marker$/;
+ $rest .= $buffer;
+ }
+ return $rest;
+}
+
+
+sub define_config_directive
+{
+ my( $directive, $rest, $dispatch )= @_;
+ $rest =~ s/^\s+//;
+ my( $new_directive, $def_text )= split /\s+/ => $rest, 2;
+
+ if( exists $dispatch->{$new_directive} )
+ {
+ warn "$new_directive already defined; skipping.\n";
+ return;
+ }
+
+ my $def= eval "sub { $def_text }";
+ if( not defined $def )
+ {
+ warn "could not compile definition for '$new_directive':"
+ . "$@; skipping.\n";
+ return;
+ }
+
+ $dispatch->{$new_directive}= $def;
+}
+
+
+## handles missing directives
+sub no_such_directive
+{
+ my( $directive )= @_;
+ $directive ||= ''; $. ||= 0;
+ warn "unrecognized directive '$directive' at line $.; ignoring.\n";
+}
+
+
+## XXX fix passed arguments processing... it defaults to space-sep which is
wrong TODO
+sub process_opts
+{
+ require Parrot::Configure::Options;
+
+ my( $var, $val, undef, $stash )= @_;
+ my $args = Parrot::Configure::Options::process_options( {
+ argv => [ defined $val ? $val : @ARGV ],
+ script => $0,
+ parrot_version => $stash->{PARROT}{parrot_version},
+ svnid => '$Id$',
+ } );
+ # XXX really? just exit? it should give a friendly message
+ exit unless defined $args;
+
+ set_parrot_var( args => $args, undef, $stash );
+}
+
+
+## sets a parrot variable to a value
+sub set_parrot_var
+{
+ my( $var, $val, undef, $stash )= @_;
+ $stash->{PARROT}{$var}= $val;
+}
+
+
+## sets a user variable to a value
+sub set_user_var
+{
+ my( $var, $val, undef, $stash )= @_;
+ $stash->{user}{$var}= $val;
+}
+
+
+## sets a configuration variable to a value
+sub set_conf_var
+{
+ my( $var, $val, undef, $stash )= @_;
+ $stash->{user}{conf}->data->set($var, $val);
+}
+
+
+## gets a parrot variable
+sub get_parrot_var { $_[3]->{PARROT}{$_[0]} }
+
+
+## gets a user variable
+sub get_user_var { $_[3]->{user}{$_[0]} }
+
+
+## gets a value from the configuration
+sub get_conf_var { $_[3]->{user}{conf}->data->get($_[0]) }
+
+
+## resets all parrot variables
+sub reset_parrot_vars
+{
+ my( undef, undef, undef, $stash )= @_;
+ delete $stash->{PARROT};
+ $stash->{PARROT}= {};
+}
+
+
+## resets all user variables
+sub reset_user_vars
+{
+ my( $var, undef, undef, $stash )= @_;
+ delete $stash->{user};
+ $stash->{user}= {};
+}
+
+
+## quit
+sub quit { exit 0 }
+
+
+$_ ^=~ { AUTHOR => 'particle' };
+
-exit(0);
################### DOCUMENTATION ###################
Added: branches/reconfigure/config/directives/configure.op
==============================================================================
--- (empty file)
+++ branches/reconfigure/config/directives/configure.op Wed Jun 13 07:10:19 2007
@@ -0,0 +1,84 @@
+## get the parrot version (or override it by passing an optional value)
+parrot_version
+
+## here i'm overriding the command-line vars passed to Configure.pl
+process_opts --test=configure
+
+## that will cause this op to run, since $args{test} eq 'configure'
+test configure
+
+## 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
+run init::manifest
+run init::defaults
+run init::install
+run init::miniparrot
+run init::hints
+run init::headers
+run inter::progs
+run inter::make
+run inter::lex
+run inter::yacc
+run auto::gcc
+run auto::msvc
+run init::optimize
+run inter::shlibs
+run inter::libparrot
+run inter::charset
+run inter::encoding
+run inter::types
+run inter::ops
+## pass options to a specific config step
+run inter::pmc --ask
+run auto::alignptrs
+run auto::headers
+run auto::sizes
+run auto::byteorder
+run auto::va_ptr
+run auto::pack
+run auto::format
+run auto::isreg
+run auto::jit
+run gen::cpu
+run auto::funcptr
+run auto::cgoto
+run auto::inline
+run auto::gc
+run auto::memalign
+run auto::signal
+run auto::socklen_t
+run auto::env
+run auto::aio
+run auto::gmp
+run auto::readline
+run auto::gdbm
+run auto::snprintf
+run auto::perldoc
+## look, i can easily disable one or more config steps now
+#run auto::python
+#run auto::m4
+run auto::cpu
+run gen::icu
+run gen::revision
+run gen::config_h
+run gen::core_pmcs
+run gen::parrot_include
+run gen::languages
+run gen::makefiles
+run gen::platform
+run gen::config_pm
+
+
+test build
+
+conclusion
+
+## dump the entire structure at any time for easy debugging
+#DUMP
+
Added: branches/reconfigure/config/directives/core.op
==============================================================================
--- (empty file)
+++ branches/reconfigure/config/directives/core.op Wed Jun 13 07:10:19 2007
@@ -0,0 +1,118 @@
+## ezcli core commands
+
+# set the parrot version to the value in the VERSION file
+# override the default behavior by passing in a value
+# e.g. "parrot_version a.b.c"
+define <<PARROT_VERSION
+parrot_version
+ require Parrot::BuildUtil;
+ my( $var, $val, $actions, $stash )= @_;
+ set_parrot_var(
+ parrot_version => $val || scalar &Parrot::BuildUtil::parrot_version(),
+ $actions, $stash
+ );
+PARROT_VERSION
+
+
+# process command-line options
+# this is defined in Configure.pl for now
+# since it's easier to get some variable values there
+define process_opts &process_opts
+
+
+# create the configure object
+define <<CONFIGURE_NEW
+configure_new
+ require Parrot::Configure;
+ set_user_var( conf => Parrot::Configure->new, @_[2,3] );
+CONFIGURE_NEW
+
+
+# add the command-line options to the configure object
+define <<CONFIGURE_SET_ARGS
+configure_set_args
+ my( $var, $val, undef, $stash )= @_;
+ my $conf = $stash->{user}{conf};
+ $conf->options->set( %{$stash->{PARROT}{args}} );
+CONFIGURE_SET_ARGS
+
+
+# add steps to perform during configure
+# XXX params are space-separated now, make sure this is okay
+# CURRENTLY UNUSED, see 'run'
+define <<ADD_STEP
+add_step
+ my( $var, $val, undef, $stash )= @_;
+ my $conf = $stash->{user}{conf};
+ my( $step, @params )= split /\s+/ => $val;
+ $conf->add_step($step, @params);
+ADD_STEP
+
+
+# add the command-line options to the configure object
+# CURRENTLY UNUSED, see 'run'
+define <<CONFIGURE_RUN
+configure_run
+ my( $var, $val, undef, $stash )= @_;
+ my $conf = $stash->{user}{conf};
+ my $args = $stash->{PARROT}{args};
+ my %args = %$args;
+
+ if ( exists $args{step} ) {
+ # from Parrot::Configure::Data
+ $conf->data()->slurp();
+ # from Parrot::Configure
+ $conf->runstep( $args{step} );
+ print "\n";
+ }
+ else {
+ # Run the actual steps
+ # from Parrot::Configure
+ $conf->runsteps or exit(1);
+ }
+CONFIGURE_RUN
+
+
+# add a step to the configure process and run it
+# XXX params are space-separated now, make sure this is okay
+# XXX it seems --step=foo is broken! TODO
+define <<RUN
+run
+ my( $var, $val, undef, $stash )= @_;
+ my $conf = $stash->{user}{conf};
+ my $args = $stash->{PARROT}{args};
+ my %args = %$args;
+
+ my( $step, @params )= split /\s+/ => $val;
+
+ if( exists $args{step} ) {
+ return unless $args{step} eq $step;
+ }
+
+ $conf->add_step($step, @params);
+# $conf->data()->slurp();
+ $conf->runstep( $step );
+RUN
+
+
+# testing directives
+define <<TEST
+test
+ require Parrot::Configure::Options::Test;
+ my( $var, $val, undef, $stash )= @_;
+ my $args = $stash->{PARROT}{args};
+ my $opttest = Parrot::Configure::Options::Test->new($args);
+ # tests will only be run if you requested them
+ # as command-line option
+ my $method = 'run_' . $_[1] . '_tests';
+ $opttest->$method();
+TEST
+
+
+# XXX this is for debugging
+define reset_parrot &reset_parrot_vars
+define reset_user &reset_user_vars
+
+
+# TODO write a 'script' task to pass in a script to execute
+# this will help support cross-compilation and multiple configurations
Added: branches/reconfigure/config/directives/intro.op
==============================================================================
--- (empty file)
+++ branches/reconfigure/config/directives/intro.op Wed Jun 13 07:10:19 2007
@@ -0,0 +1,23 @@
+## introduction and conclusion commands
+
+define <<INTRODUCTION
+introduction
+ require Parrot::Configure::Messages;
+ my( $var, $val, undef, $stash )= @_;
+ Parrot::Configure::Messages::print_introduction(
+ $stash->{PARROT}{parrot_version}
+ );
+INTRODUCTION
+
+define <<CONCLUSION
+conclusion
+ require Parrot::Configure::Messages;
+ my( $var, $val, undef, $stash )= @_;
+ my $conf = $stash->{user}{conf};
+ Parrot::Configure::Messages::print_conclusion(
+ $conf->data->get('make')
+ );
+CONCLUSION
+
+
+## vim: expandtab sw=4
Added: branches/reconfigure/config/directives/io.op
==============================================================================
--- (empty file)
+++ branches/reconfigure/config/directives/io.op Wed Jun 13 07:10:19 2007
@@ -0,0 +1,30 @@
+## io-related commands
+
+## printing
+define say defined $_[1] ? print STDOUT $_[1], $/ : print $/
+define print defined $_[1] ? print STDOUT $_[1] : 1
+define printerr defined $_[1] ? print STDERR $_[1] : 1
+
+## changing dirs
+define <<PUSHDIR
+pushdir
+ use Cwd; use File::Spec::Functions;
+ push @{$_[3]} => canonpath(cwd);
+ chdir canonpath $_[1]
+PUSHDIR
+define popdir chdir pop @{$_[3]};
+
+## debugging
+define <<DUMP
+dump
+ use Data::Dumper;
+ $Data::Dumper::Indent= 1;
+ print Data::Dumper->Dump( [ $_[3]->{$_[1]} ], [ $_[1] ] );
+DUMP
+
+## XXX - not working
+## quit
+define quit &quit;
+
+
+## vim: expandtab sw=4
Modified: branches/reconfigure/lib/Parrot/Configure.pm
==============================================================================
--- branches/reconfigure/lib/Parrot/Configure.pm (original)
+++ branches/reconfigure/lib/Parrot/Configure.pm Wed Jun 13 07:10:19 2007
@@ -211,7 +211,7 @@
my ( $verbose, $verbose_step, $ask ) = $self->options->get(qw(verbose
verbose-step ask));
for my $task ( $self->steps() ) {
- print STDERR $task->{"Parrot::Configure::Task::step"}, "\n";
+# print STDERR $task->{"Parrot::Configure::Task::step"}, "\n";
if ( $task->{"Parrot::Configure::Task::step"} eq $taskname ) {
$self->_runstep( $task, $verbose, $verbose_step, $ask, 1 );
}
