AOO410/main/solenv/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