bin/modules/SourceConfigHelper.pm

#**************************************************************
#
#  Licensed to the Apache Software Foundation (ASF) under one
#  or more contributor license agreements.  See the NOTICE file
#  distributed with this work for additional information
#  regarding copyright ownership.  The ASF licenses this file
#  to you under the Apache License, Version 2.0 (the
#  "License"); you may not use this file except in compliance
#  with the License.  You may obtain a copy of the License at
#
#    http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing,
#  software distributed under the License is distributed on an
#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
#  KIND, either express or implied.  See the License for the
#  specific language governing permissions and limitations
#  under the License.
#
#**************************************************************


#*************************************************************************
#
# SourceConfigHelper - Perl extension for parsing general info databases
#
# usage: see below
#
#*************************************************************************

package SourceConfigHelper;

use strict;

use RepositoryHelper;
use SourceConfig;
use Cwd qw (cwd);
use Carp;

my $debug = 0;
my @source_config_list; # array of sourceconfig objects

#-----------------------------------------------------------------------
#   Constants
#-----------------------------------------------------------------------

use constant SOURCE_CONFIG_NONE => 0;
use constant SOURCE_CONFIG_CURRENT_FIRST => 1;
use constant SOURCE_CONFIG_ENVIRONMENT_FIRST => 2;
use constant SOURCE_CONFIG_CURRENT_ONLY => 3;
use constant SOURCE_CONFIG_ENVIRONMENT_ONLY => 4;

use constant SOURCE_CONFIG_DEFAULT => SOURCE_CONFIG_CURRENT_FIRST;

#####  profiling #####

##### ctor #####

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $init_action = shift;
    my $self = {};
    my $SourceConfigCurrent;
    my $SourceConfigEnvironment;

    $init_action = SOURCE_CONFIG_DEFAULT if (!defined ($init_action));
    if (!eval ($init_action) or ($init_action < SOURCE_CONFIG_NONE) or ($init_action > SOURCE_CONFIG_ENVIRONMENT_ONLY)) {
        croak("wrong initial parameter: $init_action\n");
    }

    if ($init_action != SOURCE_CONFIG_NONE) {
        my $repositoryHash_ref = {};
        if ($init_action != SOURCE_CONFIG_ENVIRONMENT_ONLY) {
            my $initial_directory = cwd();
            my $result = is_repository($initial_directory, $repositoryHash_ref);
            if ($result) {
                $SourceConfigCurrent = SourceConfig->new($repositoryHash_ref->{REPOSITORY_ROOT});
            }
        }
        if ($init_action != SOURCE_CONFIG_CURRENT_ONLY) {
            my $source_config = $ENV{SOURCE_ROOT_DIR} . '/' . SourceConfig::SOURCE_CONFIG_FILE_NAME;
            if (-f $source_config) {
                $SourceConfigEnvironment = SourceConfig->new($source_config);
            }
        }

        # fill array

        if (($init_action == SOURCE_CONFIG_CURRENT_FIRST) or ($init_action == SOURCE_CONFIG_CURRENT_ONLY)) {
            if (defined ($SourceConfigCurrent)) {
                push (@source_config_list, $SourceConfigCurrent);
            }
            if ($init_action == SOURCE_CONFIG_CURRENT_FIRST) {
                if (defined ($SourceConfigEnvironment)) {
                    push (@source_config_list, $SourceConfigEnvironment);
                }
            }
        }
        elsif (($init_action == SOURCE_CONFIG_ENVIRONMENT_FIRST) or ($init_action == SOURCE_CONFIG_ENVIRONMENT_ONLY)) {
            if (defined ($SourceConfigEnvironment)) {
                push (@source_config_list, $SourceConfigEnvironment);
            }
            if ($init_action == SOURCE_CONFIG_ENVIRONMENT_FIRST) {
                if (defined ($SourceConfigCurrent)) {
                    push (@source_config_list, $SourceConfigCurrent);
                }
            }
        }
    }

    $self->{SOURCE_CONFIG_LIST} = \@source_config_list;

    bless($self, $class);
    return $self;
}

##### methods #####

############################################################################################

sub add_SourceConfig {
    my $self = shift;
    my $source_config = shift;
    push (@{$self->{SOURCE_CONFIG_LIST}}, $source_config);
}

############################################################################################

sub get_SourceConfigList {
    my $self = shift;
    return @{$self->{SOURCE_CONFIG_LIST}};
}

############################################################################################

sub has_SourceConfig {
    my $self = shift;
    my $result = 0;
    my $count = @{$self->{SOURCE_CONFIG_LIST}};
    $result = 1 if ($count > 0);
    return $result;
}

############################################################################################

sub get_module_path {
    my $self = shift;
    my $module = shift;
    my $function = \&SourceConfig::get_module_path;
    my $result;
    $result = $self->get_StringResult ($function, $module);
    return $result;
}

############################################################################################

sub get_active_modules {
    my $self = shift;
    my $parameter; # empty
    my $function = \&SourceConfig::get_active_modules;
    my $array_ref;
    $array_ref = $self->get_ArrayResult ($function, $parameter);
    return @$array_ref;
}

############################################################################################

sub get_repositories {
    my $self = shift;
    my $parameter; # empty
    my $function = \&SourceConfig::get_repositories;
    my $array_ref;
    $array_ref = $self->get_ArrayResult ($function, $parameter);
    return @$array_ref;
}

############################################################################################

sub get_module_repository {
    my $self = shift;
    my $module = shift;
    my $function = \&SourceConfig::get_module_repository;
    my $result;
    $result = $self->get_StringResult ($function, $module);
    return $result;
}

############################################################################################

sub is_active {
    my $self = shift;
    my $module = shift;
    my $function = \&SourceConfig::is_active;
    my $result_ref;
    my $is_active = 0;
    $result_ref = $self->get_ResultOfList ($function, $module);
    my $count = @$result_ref;
    if ($count>0) {
        foreach my $active (@$result_ref) {
            if ($active) {
                $is_active = $active;
            }
        }
    }
    return $is_active;
}

##### private methods #####

############################################################################################
#
# is_repository () : check if the directory is a valid repository
#
# input: - directory
#        - hash reference, where the output will be stored
#
# output: 0 = FALSE, the directory is no valid repository
#         1 = TRUE, the repository root can be found in $repositoryHash_ref->{REPOSITORY_ROOT}
#
############################################################################################

sub is_repository {
    my $directory = shift;
    my $repositoryHash_ref = shift;
    $repositoryHash_ref->{INITIAL_DIRECTORY} = $directory;
    $repositoryHash_ref->{REPOSITORY_ROOT} = undef;
    $repositoryHash_ref->{REPOSITORY_NAME} = undef;
    my $result = RepositoryHelper::search_via_build_lst($repositoryHash_ref);
    chdir $repositoryHash_ref->{INITIAL_DIRECTORY};
    if (!$result) {
        $result = RepositoryHelper::search_for_hg($repositoryHash_ref);
    }
    return $result;
}

############################################################################################
#
# get_ResultOfList(): give back an array reference from all SourceConfig Objects results
#
# input: - function : reference to the called function of each SourceConfig Object
#        - parameter : parameter for the called function
#
# output: result : array of all results
#
############################################################################################

sub get_ResultOfList {
    my $self = shift;
    my $function = shift;
    my $parameter = shift;
    my @result;
    foreach my $source_config (@{$self->{SOURCE_CONFIG_LIST}}) {
        push (@result, &$function ($source_config, $parameter));
    }
    return \@result;
}

############################################################################################
#
# get_StringResult(): give back the first defined result from all SourceConfig Objects
#
# input: - function : reference to the called function of each SourceConfig Object
#        - parameter : parameter for the called function
#
# output: result : scalar variable (string), undef if no result
#
############################################################################################

sub get_StringResult {
    my $self = shift;
    my $function = shift;
    my $parameter = shift;
    my $result_ref;
    $result_ref = $self->get_ResultOfList ($function, $parameter);
    my $count = @$result_ref;
    if ($count>0) {
        my $value;
        my $i = 0;
        while (($i < $count) and !defined ($value)) { # search the first defined result
            $value = $$result_ref[$i];
            $i++;
        }
        return $value;
    }
    return undef;
}

############################################################################################
#
# get_StringResult(): give back a sorted and uniqe array reference of the results
#                     from all SourceConfig Objects
#
# input: - function : reference to the called function of each SourceConfig Object
#        - parameter : parameter for the called function
#
# output: result : sorted and uniqe array reference
#
############################################################################################

sub get_ArrayResult {
    my $self = shift;
    my $function = shift;
    my $parameter = shift;
    my $result_ref;
    my @modules;
    $result_ref = $self->get_ResultOfList ($function, $parameter);
    my $count = @$result_ref;
    if ($count>0) {
        my %moduleHash;
        foreach my $module (@$result_ref) {
            $moduleHash{$module}++;
        }
        @modules = sort keys %moduleHash;
    }
    return \@modules;
}

 ##### finish #####

1; # needed by use or require

__END__

=head1 NAME

SourceConfigHelper - Perl extension for handling with SourceConfigObjetcs

=head1 SYNOPSIS

    # example that will read source_config file and return the active repositories

    use SourceConfigHelper;

    # Create a new instance:
    $a = SourceConfigHelper->new();

    # Get repositories for the actual workspace:
    $a->get_repositories();

=head1 DESCRIPTION

SourceConfigHelper is a perl extension to handle more than one objects of SourceConfig
to set up a search order for modules.

Methods:

SourceConfigHelper::new()

Creates a new instance of SourceConfigHelper. Can be initialized by: default - empty or with a constant of search order. default: the source_config will be taken first from the current repository and second from the environment
Possible parameters are:
SourceConfigHelper::SOURCE_CONFIG_NONE - no SourceConfig Object will be created
SourceConfigHelper::SOURCE_CONFIG_CURRENT_FIRST - use the current repository first
SourceConfigHelper::SOURCE_CONFIG_ENVIRONMENT_FIRST - use the repository of the environment first
SourceConfigHelper::SOURCE_CONFIG_CURRENT_ONLY - use only the current repository
SourceConfigHelper::SOURCE_CONFIG_ENVIRONMENT_ONLY - use only the repository of the environment

SourceConfigHelper::get_repositories()

Returns sorted list of active repositories for the actual workspace

SourceConfigHelper::get_active_modules()

Returns a sorted list of active modules

SourceConfigHelper::get_all_modules()

Returns sorted list of all modules in active repositories.

SourceConfigHelper::get_module_path($module)

Returns absolute module path. If the module is not active or don't exists, "undef" will be returned.

SourceConfigHelper::get_module_repository($module)

Returns the module's repository. If the module is not active or don't exists, "undef" will be returned.

SourceConfigHelper::is_active()

Returns 1 (TRUE) if a module is active
Returns 0 (FALSE) if a module is not active

SourceConfigHelper::add_SourceConfig($SourceConfigObject)

Add the SourceConfigObject to the end of the list

SourceConfigHelper::get_SourceConfigList()

Return an array of SourceConfigObjects

SourceConfigHelper::has_SourceConfig()

Returns 1 (TRUE) if one or more SourceConfig Objects is in the list
Returns 0 (FALSE) if no SourceConfig Object is in the list (can happen if there is no valid repository)

=head2 EXPORT

SourceConfigHelper::new()
SourceConfigHelper::get_repositories()
SourceConfigHelper::get_active_modules()
SourceConfigHelper::get_all_modules()
SourceConfigHelper::get_module_path($module)
SourceConfigHelper::get_module_repository($module)
SourceConfigHelper::is_active($module)
SourceConfigHelper::add_SourceConfig($SourceConfigObject)
SourceConfigHelper::get_SourceConfigList()
SourceConfigHelper::has_SourceConfig()

=head1 AUTHOR

Kurt Zenker, kz@openoffice.org

=head1 SEE ALSO

perl(1).

=cut