From 7dc9d0ff2b5c0bc8b64199882055a1fb2c096260 Mon Sep 17 00:00:00 2001 From: Michael Pyne Date: Sun, 15 Sep 2013 18:05:09 -0400 Subject: [PATCH] Extract options and mainline code into separate module. This is to support being able to improve and expand the test suite by (eventually) having a simple function call to setup different modules to be tested. --- CMakeLists.txt | 1 + kdesrc-build | 1372 +--------------------------------- modules/ksb/Application.pm | 1445 ++++++++++++++++++++++++++++++++++++ 3 files changed, 1463 insertions(+), 1355 deletions(-) create mode 100644 modules/ksb/Application.pm diff --git a/CMakeLists.txt b/CMakeLists.txt index 762cdbd..fd6018f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -18,6 +18,7 @@ set(KDESRC_BUILD_MODULE_INSTALL_PREFIX "${DATA_INSTALL_DIR}/kdesrc-build/modules if (KDESRC_BUILD_INSTALL_MODULES) message(STATUS "Installing component modules to ${KDESRC_BUILD_MODULE_INSTALL_PREFIX}") install(FILES + modules/ksb/Application.pm modules/ksb/BuildContext.pm modules/ksb/BuildException.pm modules/ksb/BuildSystem.pm diff --git a/kdesrc-build b/kdesrc-build index 36266d4..a386420 100755 --- a/kdesrc-build +++ b/kdesrc-build @@ -44,30 +44,29 @@ use warnings; use Fcntl qw(:DEFAULT :seek); # For sysopen constants use Carp; use POSIX qw(strftime :sys_wait_h _exit); +use Data::Dumper; use File::Basename; # basename use File::Find; # For our lndir reimplementation. use File::Path qw(remove_tree); use File::Glob ':glob'; use File::Spec; # tmpdir, rel2abs -use List::Util qw(first min); use LWP::UserAgent; use URI; # For git-clone snapshot support use Sys::Hostname; use Storable 'dclone'; use IO::Handle; use IO::Select; -use Data::Dumper; use ksb::Debug; use ksb::Util; use ksb::Version qw(scriptVersion); +use ksb::Application; use ksb::IPC 0.20; use ksb::IPC::Pipe 0.20; use ksb::IPC::Null; use ksb::KDEXMLReader; use ksb::Updater::Git; use ksb::BuildContext 0.20; -use ksb::RecursiveFH; use ksb::Module; use ksb::ModuleSet; use ksb::ModuleSet::KDEProjects; @@ -87,19 +86,8 @@ $SIG{__DIE__} = \&Carp::confess; # global variables {{{ -use constant { - # We use a named remote to make some git commands work that don't accept the - # full path. - KDE_PROJECT_ID => 'kde-projects', # git-repository-base for kde_projects.xml -}; - my $SCRIPT_VERSION = scriptVersion(); -# This is a hash since Perl doesn't have a "in" keyword. -my %ignore_list; # List of packages to refuse to include in the build list. - -my $run_mode = 'build'; # Determines if updating, building, installing, etc. - # }}} # Function: moveOldDirectories @@ -444,464 +432,6 @@ sub installCustomSessionDriver } } -# Reads a "line" from a file. This line is stripped of comments and extraneous -# whitespace. Also, backslash-continued multiple lines are merged into a single -# line. -# -# First parameter is the reference to the filehandle to read from. -# Returns the text of the line. -sub readNextLogicalLine -{ - my $fileReader = shift; - - while($_ = $fileReader->readLine()) { - # Remove trailing newline - chomp; - - # Replace \ followed by optional space at EOL and try again. - if(s/\\\s*$//) - { - $_ .= $fileReader->readLine(); - redo; - } - - s/#.*$//; # Remove comments - next if /^\s*$/; # Skip blank lines - - return $_; - } - - return undef; -} - -# Takes an input line, and extracts it into an option name, and simplified -# value. The value has "false" converted to 0, white space simplified (like in -# Qt), and tildes (~) in what appear to be path-like entries are converted to -# the home directory path. -# -# First parameter is the input line. -# Return value is (optionname, option-value) -sub split_option_value -{ - my $ctx = assert_isa(shift, 'ksb::BuildContext'); - my $input = shift; - my $optionRE = qr/\$\{([a-zA-Z0-9-]+)\}/; - - # The option is the first word, followed by the - # flags on the rest of the line. The interpretation - # of the flags is dependant on the option. - my ($option, $value) = ($input =~ /^\s* # Find all spaces - ([-\w]+) # First match, alphanumeric, -, and _ - # (?: ) means non-capturing group, so (.*) is $value - # So, skip spaces and pick up the rest of the line. - (?:\s+(.*))?$/x); - - $value = "" unless defined $value; - - # Simplify this. - $value =~ s/\s+$//; - $value =~ s/^\s+//; - $value =~ s/\s+/ /; - - # Check for false keyword and convert it to Perl false. - $value = 0 if lc($value) eq 'false'; - - # Replace reference to global option with their value. - # The regex basically just matches ${option-name}. - my ($sub_var_name) = ($value =~ $optionRE); - while ($sub_var_name) - { - my $sub_var_value = $ctx->getOption($sub_var_name) || ''; - if(!$ctx->hasOption($sub_var_value)) { - warning (" *\n * WARNING: $sub_var_name is not set at line y[$.]\n *"); - } - - debug ("Substituting \${$sub_var_name} with $sub_var_value"); - - $value =~ s/\${$sub_var_name}/$sub_var_value/g; - - # Replace other references as well. Keep this RE up to date with - # the other one. - ($sub_var_name) = ($value =~ $optionRE); - } - - # Replace tildes with home directory. - 1 while ($value =~ s"(^|:|=)~/"$1$ENV{'HOME'}/"); - - return ($option, $value); -} - -# Reads in the options from the config file and adds them to the option store. -# The first parameter is a BuildContext object to use for creating the returned -# ksb::Module under. -# The second parameter is a reference to the file handle to read from. -# The third parameter is the module name. It can be either an -# already-constructed ksb::Module object (in which case it is used directly and any -# options read for the module are applied directly to the object), or it can be -# a string containing the module name (in which case a new ksb::Module object will -# be created). For global options the module name should be 'global', or just -# pass in the BuildContext for this param as well. -# -# The return value is the ksb::Module with options set as given in the configuration -# file for that module. If global options were being read then a BuildContext -# is returned (but that is-a ksb::Module anyways). -sub parse_module -{ - my ($ctx, $fileReader, $moduleOrName) = @_; - assert_isa($ctx, 'ksb::BuildContext'); - - my $rcfile = $ctx->rcFile(); - my $module; - - # Figure out what objects to store options into. If given, just use - # that, otherwise use context or a new ksb::Module depending on the name. - if (ref $moduleOrName) { - $module = $moduleOrName; - assert_isa($module, 'ksb::Module'); - } - elsif ($moduleOrName eq 'global') { - $module = $ctx; - } - else { - $module = ksb::Module->new($ctx, $moduleOrName); - } - - my $endWord = $module->isa('ksb::BuildContext') ? 'global' : 'module'; - my $endRE = qr/^end\s+$endWord/; - - # Read in each option - while ($_ = readNextLogicalLine($fileReader)) - { - last if m/$endRE/; - - # Sanity check, make sure the section is correctly terminated - if(/^(module\s|module$)/) - { - error ("Invalid configuration file $rcfile at line $.\nAdd an 'end $endWord' before " . - "starting a new module.\n"); - die make_exception('Config', "Invalid $rcfile"); - } - - my ($option, $value) = split_option_value($ctx, $_); - - # Handle special options. - if ($module->isa('ksb::BuildContext') && $option eq 'git-repository-base') { - # This will be a hash reference instead of a scalar - my ($repo, $url) = ($value =~ /^([a-zA-Z0-9_-]+)\s+(.+)$/); - $value = $ctx->getOption($option) || { }; - - if (!$repo || !$url) { - error (<<"EOF"); -The y[git-repository-base] option at y[b[$rcfile:$.] -requires a repository name and URL. - -e.g. git-repository base y[b[kde] g[b[git://anongit.kde.org/] - -Use this in a "module-set" group: - -e.g. -module-set kdesupport-set - repository y[b[kde] - use-modules automoc akonadi soprano attica -end module-set -EOF - die make_exception('Config', "Invalid git-repository-base"); - } - - $value->{$repo} = $url; - } - # Read ~~ as "is in this list:" - elsif ($option ~~ [qw(git-repository-base use-modules ignore-modules)]) { - error (" r[b[*] module b[$module] (near line $.) should be declared as module-set to use b[$option]"); - die make_exception('Config', "Option $option can only be used in module-set"); - } - elsif ($option eq 'filter-out-phases') { - for my $phase (split(' ', $value)) { - $module->phases()->filterOutPhase($phase); - } - - next; # Don't fallthrough to set the option - } - - $module->setOption($option, $value); - } - - return $module; -} - -# Reads in a "moduleset". -# -# First parameter is the filehandle to the config file to read from. -# Second parameter is the name of the moduleset, which is really the name -# of the base repository to use. -# Returns a ksb::ModuleSet describing the module-set encountered, which may -# need to be further expanded (see ksb::ModuleSet::convertToModules). -sub parse_moduleset -{ - my $ctx = assert_isa(shift, 'ksb::BuildContext'); - my $fileReader = shift; - my $moduleSetName = shift || ''; - my $rcfile = $ctx->rcFile(); - - my $startLine = $.; # For later error messages - my $internalModuleSetName = - $moduleSetName || ""; - - my $moduleSet = ksb::ModuleSet->new($ctx, $internalModuleSetName); - my %optionSet; # We read all options, and apply them to all modules - - while($_ = readNextLogicalLine($fileReader)) { - last if /^end\s+module(-?set)?$/; - - my ($option, $value) = split_option_value($ctx, $_); - - if ($option eq 'use-modules') { - my @modules = split(' ', $value); - - if (not @modules) { - error ("No modules were selected for the current module-set"); - error ("in the y[use-modules] on line $. of $rcfile"); - die make_exception('Config', 'Invalid use-modules'); - } - - $moduleSet->setModulesToFind(@modules); - } - elsif ($option eq 'ignore-modules') { - my @modulesToIgnore = split(' ', $value); - - if (not @modulesToIgnore) { - error ("No modules were selected for the current module-set"); - error ("in the y[ignore-modules] on line $. of $rcfile"); - die make_exception('Config', 'Invalid ignore-modules'); - } - - $moduleSet->setModulesToIgnore(@modulesToIgnore); - } - elsif ($option eq 'set-env') { - Module::processSetEnvOption(\%optionSet, $option, $value); - } - else { - $optionSet{$option} = $value; - } - } - - $moduleSet->setOptions(\%optionSet); - - # Check before we use this module set whether the user did something silly. - my $repoSet = $ctx->getOption('git-repository-base'); - if (!exists $optionSet{'repository'}) { - error (<{$optionSet{'repository'}}) - { - my $projectID = KDE_PROJECT_ID; - my $moduleSetId = $moduleSetName ? "module-set ($moduleSetName)" - : "module-set"; - - error (< in an input list from the command line that name -# module-sets listed in the configuration file, and returns the new list. -# -# are ignored if found in the input list, and transferred to the -# output list in the same relative order. -# -# This function may result in kde-projects metadata being downloaded and -# processed. -# -# Parameters: -# $ctx - in use for this script execution. -# @modules - list of , to be expanded. -# -# Returns: -# $metadataModule - a to use if needed for kde-projects support, can be -# undef if not actually required this run. -# @modules - List of with any module-sets expanded into . -sub expandModuleSets -{ - my ($ctx, @buildModuleList) = @_; - - my $filter = sub { - my $moduleOrSetName = $_->name(); - - # 'proj' module types can only come from command line -- we assume the - # user is trying to build a module from the kde-projects repo without - # first putting into rc-file. - if ($_->isa('ksb::Module') && $_->scmType() ne 'proj') { - return $_; - } - - if ($_->isa('ksb::ModuleSet')) { - return $_->convertToModules($ctx); - } - - my $moduleSet = ksb::ModuleSet::KDEProjects->new($ctx, ''); - $moduleSet->setModulesToFind($_->name()); - $moduleSet->{options}->{'#guessed-kde-project'} = 1; - - debug ("--- Trying to find a home for $_"); - return $moduleSet->convertToModules($ctx); - }; - - my @moduleResults = map { &$filter } (@buildModuleList); - my $metadataModule; - - if (first { $_->scmType() eq 'proj' } @moduleResults) { - debug ("Introducing metadata module into the build"); - $metadataModule = ksb::ModuleSet::KDEProjects::getMetadataModule($ctx); - assert_isa($metadataModule, 'ksb::Module'); - } - - return ($metadataModule, @moduleResults); -} - -# Function: read_options -# -# Reads in the settings from the configuration, passed in as an open -# filehandle. -# -# Phase: -# initialization - Do not call from this function. -# -# Parameters: -# ctx - The to update based on the configuration read. -# filehandle - The I/O object to read from. Must handle _eof_ and _readline_ -# methods (e.g. subclass). -# -# Returns: -# @module - Heterogenous list of and defined in the -# configuration file. No module sets will have been expanded out (either -# kde-projects or standard sets). -# -# Throws: -# - Config exceptions. -sub read_options -{ - my $ctx = assert_isa(shift, 'ksb::BuildContext'); - my $fh = shift; - my @module_list; - my $rcfile = $ctx->rcFile(); - my ($option, $modulename, %readModules); - - my $fileReader = ksb::RecursiveFH->new(); - $fileReader->addFilehandle($fh); - - # Read in global settings - while ($_ = $fileReader->readLine()) - { - s/#.*$//; # Remove comments - s/^\s*//; # Remove leading whitespace - next if (/^\s*$/); # Skip blank lines - - # First command in .kdesrc-buildrc should be a global - # options declaration, even if none are defined. - if (not /^global\s*$/) - { - error ("Invalid configuration file: $rcfile."); - error ("Expecting global settings section at b[r[line $.]!"); - die make_exception('Config', 'Missing global section'); - } - - # Now read in each global option. - parse_module($ctx, $fileReader, 'global'); - last; - } - - my $using_default = 1; - - # Now read in module settings - while ($_ = $fileReader->readLine()) - { - s/#.*$//; # Remove comments - s/^\s*//; # Remove leading whitespace - next if (/^\s*$/); # Skip blank lines - - # Get modulename (has dash, dots, slashes, or letters/numbers) - ($modulename) = /^module\s+([-\/\.\w]+)\s*$/; - - if (not $modulename) - { - my $moduleSetRE = qr/^module-set\s*([-\/\.\w]+)?\s*$/; - ($modulename) = m/$moduleSetRE/; - - # modulename may be blank -- use the regex directly to match - if (not /$moduleSetRE/) { - error ("Invalid configuration file $rcfile!"); - error ("Expecting a start of module section at r[b[line $.]."); - die make_exception('Config', 'Ungrouped/Unknown option'); - } - - # A moduleset can give us more than one module to add. - push @module_list, parse_moduleset($ctx, $fileReader, $modulename); - } - else { - # Overwrite options set for existing modules. - if (my @modules = grep { $_->name() eq $modulename } @module_list) { - # We check for definedness as a module-set can exist but be - # unnamed. - if ($modules[0]->moduleSet()->isa('ksb::ModuleSet::Null')) { - warning ("Multiple module declarations for $modules[0]"); - } - - parse_module($ctx, $fileReader, $modules[0]); # Don't re-add - } - else { - push @module_list, parse_module($ctx, $fileReader, $modulename); - } - } - - # Don't build default modules if user has their own wishes. - $using_default = 0; - } - - # If the user doesn't ask to build any modules, build a default set. - # The good question is what exactly should be built, but oh well. - if ($using_default) { - warning (" b[y[*] There do not seem to be any modules to build in your configuration."); - return (); - } - - return @module_list; -} - # Print out an error message, and a list of modules that match that error # message. It will also display the log file name if one can be determined. # The message will be displayed all in uppercase, with PACKAGES prepended, so @@ -974,480 +504,6 @@ sub output_failed_module_lists } } -# This subroutine extract the value from options of the form --option=value, -# which can also be expressed as --option value. The first parameter is the -# option that the user passed to the cmd line (e.g. --prefix=/opt/foo), and -# the second parameter is a reference to the list of command line options. -# The return value is the value of the option (the list might be shorter by -# 1, copy it if you don't want it to change), or undef if no value was -# provided. -sub extract_option_value($\@) -{ - my ($option, $options_ref) = @_; - - if ($option =~ /=/) - { - my @value = split(/=/, $option); - shift @value; # We don't need the first one, that the --option part. - - return undef if (scalar @value == 0); - - # If we have more than one element left in @value it's because the - # option itself has an = in it, make sure it goes back in the answer. - return join('=', @value); - } - - return undef if scalar @{$options_ref} == 0; - return shift @{$options_ref}; -} - -# Like extract_option_value, but throws an exception if the value is not actually present, -# so you don't have to check for it yourself. If you do get a return value, it will be -# defined to something. -sub extract_option_value_required($\@) -{ - my ($option, $options_ref) = @_; - my $returnValue = extract_option_value($option, @$options_ref); - - if (not defined $returnValue) { - croak_runtime("Option $option needs to be set to some value instead of left blank"); - } - - return $returnValue; -} - -# Function: process_arguments -# -# Processes the command line arguments, which are used to modify the given -# and possibly return a list of . -# -# Phase: -# initialization - Do not call from this function. -# -# Parameters: -# ctx - BuildContext in use. -# pendingOptions - hashref to hold parsed modules options to be applied later. -# *Note* this must be done separately, it is not handled by this subroutine. -# @options - The remainder of the arguments are treated as command line -# arguments to process. -# -# Returns: -# - List of that represent modules specifically entered on the -# command-line, _or_ -# - List of options to pass to a command named by the --run command line -# option. (This is true if and only if the _ctx_ ends up with the -# _#start-program_ option set). -sub process_arguments -{ - my $ctx = assert_isa(shift, 'ksb::BuildContext'); - my $pendingOptions = shift; - my $phases = $ctx->phases(); - my @savedOptions = @_; # Used for --debug - my @options = @_; - my $arg; - my $version = "kdesrc-build $SCRIPT_VERSION"; - my $author = < - -Many people have contributed code, bugfixes, and documentation. - -Please report bugs using the KDE Bugzilla, at http://bugs.kde.org/ -DONE - - my @enteredModules; - - while ($_ = shift @options) - { - SWITCH: { - /^(--version)$/ && do { print "$version\n"; exit; }; - /^--author$/ && do { print $author; exit; }; - /^(-h)|(--?help)$/ && do { - print < Read configuration from filename instead of default. - - --resume-from= Skips modules until just before the given package, - then operates as normal. - --resume-after= Skips modules up to and including the given package, - then operates as normal. - - --stop-before= Skips the given package and all later packages. - --stop-after= Skips all packages after the given package. - - --reconfigure Run CMake/configure again, but don't clean the build - directory. - --build-system-only Create the build infrastructure, but don't actually - perform the build. - - --