AOO410/main/solenv/bin/modules/SourceConfig.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.
#  
#**************************************************************



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

package SourceConfig;

use strict;

use constant SOURCE_CONFIG_FILE_NAME => 'source_config'; 
use constant SOURCE_CONFIG_VERSION => 3; 

use Carp;
use Cwd;
use RepositoryHelper;
use File::Basename;
use File::Temp qw(tmpnam);

my $debug = 0;

#####  profiling #####

##### ctor #####

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $source_root = shift;
    my @additional_repositories = @_;
    
    my $self = {};
    $self->{USER_SOURCE_ROOT} = undef;
    $self->{SOURCE_CONFIG_FILE} = undef;
    if (defined $source_root) {
        $source_root = Cwd::realpath($source_root);
        $source_root =~ s/\\|\/$//;
        if (-f $source_root) {
            # We have path to source_config 
            if (File::Basename::basename($source_root) eq 'source_config') {
                # We have path to source_config 
                $self->{SOURCE_CONFIG_FILE} = $source_root;
                $source_root = File::Basename::dirname($source_root);
            } else {
                croak("$source_root is not a source_config file");
            };
        } else {
            $self->{USER_SOURCE_ROOT} = $source_root;
            $source_root .= '/..';
        }
    } else {
        $source_root = $ENV{SOURCE_ROOT_DIR};
    };
    $source_root = Cwd::realpath($source_root);
    $self->{SOURCE_ROOT} = $source_root;
    $self->{DEBUG} = 0;
    $self->{VERBOSE} = 0;
    $self->{REPOSITORIES} = {};
    $self->{ACTIVATED_REPOSITORIES} = {};
    $self->{MODULE_PATHS} = {};
    $self->{MODULE_BUILD_LIST_PATHS} = {};
    $self->{ACTIVATED_MODULES} = {};
    $self->{MODULE_REPOSITORY} = {};
    $self->{REAL_MODULES} = {};
    $self->{NEW_MODULES} = [];
    $self->{REMOVE_MODULES} = {};
    $self->{REMOVE_REPOSITORIES} = {};
    $self->{NEW_REPOSITORIES} = [];
    $self->{WARNINGS} = [];
    $self->{REPORT_MESSAGES} = [];
    $self->{CONFIG_FILE_CONTENT} = [];
    if (defined $self->{USER_SOURCE_ROOT}) {
        ${$self->{REPOSITORIES}}{File::Basename::basename($self->{USER_SOURCE_ROOT})} = $self->{USER_SOURCE_ROOT};
    };
    $self->{SOURCE_CONFIG_FILE} = get_config_file($self->{SOURCE_ROOT}) if (!defined $self->{SOURCE_CONFIG_FILE});
    $self->{SOURCE_CONFIG_DEFAULT} = $self->{SOURCE_ROOT} .'/'.SOURCE_CONFIG_FILE_NAME;
    if (defined $self->{USER_SOURCE_ROOT}) {
        ${$self->{REPOSITORIES}}{File::Basename::basename($self->{USER_SOURCE_ROOT})} = $self->{USER_SOURCE_ROOT};
    };
    foreach my $additional_repository (@additional_repositories)
    {
        ${$self->{REPOSITORIES}}{File::Basename::basename($additional_repository)} = $additional_repository;
    }
    
    read_config_file($self);
   	get_module_paths($self);
    bless($self, $class);
    return $self;
}

##### methods #####

sub get_version {
    return SOURCE_CONFIG_VERSION;
};

sub get_repositories 
{   
    my $self        = shift;
    return sort keys %{$self->{REPOSITORIES}};
}

sub add_repository 
{   
    my $self        = shift;
    my $new_rep_path = shift;
    $new_rep_path = Cwd::realpath($new_rep_path);
    my $new_rep_name = File::Basename::basename($new_rep_path);
    if (defined ${$self->{REPOSITORIES}}{$new_rep_name}) {
        croak("Repository $new_rep_name is already defined!!");
    };
    ${$self->{REPOSITORIES}}{$new_rep_name} = $new_rep_path;
    $self -> get_repository_module_paths($new_rep_name);
}

sub get_config_file_default_path {
    my $self        = shift;
    return $self->{SOURCE_CONFIG_DEFAULT};
}

sub get_config_file_path {
    my $self = shift;
    return $self->{SOURCE_CONFIG_FILE};
}

sub get_module_repository {
    my $self = shift;
    my $module = shift;
    if (defined ${$self->{MODULE_REPOSITORY}}{$module}) {
        return ${$self->{MODULE_REPOSITORY}}{$module};
    } else {
        Carp::cluck("No such module $module in active repositories!!\n");
        return undef;
    };
}

sub get_module_path {
    my $self = shift;
    my $module = shift;
    if (defined ${$self->{MODULE_PATHS}}{$module}) {
        return ${$self->{MODULE_PATHS}}{$module};
    } else {
        Carp::cluck("No path for module $module in active repositories!!\n") if ($debug);
        return undef;
    };
}

sub get_module_build_list {
    my $self = shift;
    my $module = shift;
    if (defined ${$self->{MODULE_BUILD_LIST_PATHS}}{$module}) {
        return ${$self->{MODULE_BUILD_LIST_PATHS}}{$module};
    } else {
        my @possible_build_lists = ('build.lst', 'build.xlist'); # build lists names
        foreach (@possible_build_lists) {
            my $possible_path = ${$self->{MODULE_PATHS}}{$module} . "/prj/$_";
            if (-e $possible_path) {
                ${$self->{MODULE_BUILD_LIST_PATHS}}{$module} = $possible_path;
                return $possible_path;
            };
        };
        Carp::cluck("No build list in module $module found!!\n") if ($self->{DEBUG});
        return undef;
    };
}

sub get_all_modules 
{   
    my $self = shift;
    my $module = shift;
    return sort keys %{$self->{MODULE_PATHS}};
};

sub get_active_modules 
{
    my $self        = shift;
    if (scalar keys %{$self->{ACTIVATED_MODULES}}) {
        return sort keys %{$self->{ACTIVATED_MODULES}};
	}
   	return sort keys %{$self->{REAL_MODULES}};
}

sub is_active
{
    my $self        = shift;
    my $module		= shift;
    if (scalar keys %{$self->{ACTIVATED_MODULES}}) {
        return exists ($self->{ACTIVATED_MODULES}{$module});
	}
    return exists ($self->{REAL_MODULES}{$module});
}

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

sub get_repository_module_paths {
    my $self        = shift;
    my $repository        = shift;
    my $repository_path = ${$self->{REPOSITORIES}}{$repository};
    if (opendir DIRHANDLE, $repository_path) {
        foreach my $module (readdir(DIRHANDLE)) {
            next if (($module =~ /^\.+/) || (!-d "$repository_path/$module"));
            my $module_entry = $module;
            if (($module !~ s/\.lnk$//) && ($module !~ s/\.link$//)) {
                $self->{REAL_MODULES}{$module}++;
            }
            my $possible_path = "$repository_path/$module_entry";
            if (-d $possible_path) {
                if (defined ${$self->{MODULE_PATHS}}{$module}) {
                    close DIRHANDLE;
                    croak("Ambiguous paths for module $module: $possible_path and " . ${$self->{MODULE_PATHS}}{$module});
                };
                ${$self->{MODULE_PATHS}}{$module} = $possible_path;
                ${$self->{MODULE_REPOSITORY}}{$module} = $repository;
            }
        };
        close DIRHANDLE;
    } else {
        croak("Cannot read $repository_path repository content");
    };
};

sub get_module_paths {
    my $self        = shift;
    foreach my $repository (keys %{$self->{REPOSITORIES}}) {
        get_repository_module_paths($self, $repository);
    };
    my @false_actives = ();
    foreach (keys %{$self->{ACTIVATED_MODULES}}) {
        push(@false_actives, $_) if (!defined  ${$self->{MODULE_PATHS}}{$_});
    };
    croak("Error!! Activated module(s): @false_actives\nnot found in the active repositories!! Please check your " . $self->{SOURCE_CONFIG_FILE} . "\n") if (scalar @false_actives);
    croak("No modules found!") if (!scalar keys %{$self->{MODULE_PATHS}});
};

sub get_config_file {
    my $source_root = shift;
    my $possible_path = $source_root . '/' . SOURCE_CONFIG_FILE_NAME;
    return $possible_path if (-f $possible_path);
    return '';
};

#
# Fallback - fallback repository is based on RepositoryHelper educated guess
#
sub get_fallback_repository {
    my $self = shift;
    my $repository_root = RepositoryHelper->new()->get_repository_root();
    ${$self->{REPOSITORIES}}{File::Basename::basename($repository_root)} = $repository_root;
};

sub read_config_file {
    my $self = shift;
    if (!$self->{SOURCE_CONFIG_FILE}) {
        if (!defined $self->{USER_SOURCE_ROOT}) {
            get_fallback_repository($self);
        };
        return;
    };
    my $repository_section = 0;
    my $module_section = 0;
    my $line = 0;
    my @file_content = ();

    if (open(SOURCE_CONFIG_FILE, $self->{SOURCE_CONFIG_FILE})) {
        foreach (<SOURCE_CONFIG_FILE>) {
            push (@{$self->{CONFIG_FILE_CONTENT}}, $_);
            $line++;
            chomp;
            next if (!/^\S+/);
            next if (/^\s*#+/);
            s/\r\n//;
            if (/^\[repositories\]\s*(\s+#)*/) {
                $module_section = 0;
                $repository_section = 1;
                next;
            };
            if (/^\[modules\]\s*(\s+#)*/) {
                $module_section = 1;
                $repository_section = 0;
                next;
            };
            next if (!$repository_section && !$module_section);
            if (/\s*(\S+)=active\s*(\s+#)*/) {
                if ($repository_section) {
                    my $repository_source_path = $self->{SOURCE_ROOT} . "/$1";
                    if (defined $ENV{UPDMINOREXT}) {
                        $repository_source_path .= $ENV{UPDMINOREXT};
                        if (defined ${$self->{REPOSITORIES}}{$1.$ENV{UPDMINOREXT}}) {
                            delete ${$self->{REPOSITORIES}}{$1.$ENV{UPDMINOREXT}};
                        };
                    };
                    ${$self->{REPOSITORIES}}{$1} = $repository_source_path;
                    ${$self->{ACTIVATED_REPOSITORIES}}{$1}++;
                    next;
                }
                if ($module_section) {
                    ${$self->{ACTIVATED_MODULES}}{$1}++;
                    next;
                };
            };
            croak("Line $line in " . $self->{SOURCE_CONFIG_FILE} . ' violates format. Please make your checks!');
        };
        close SOURCE_CONFIG_FILE;
        if (!scalar keys %{$self->{REPOSITORIES}}) {
            get_fallback_repository($self);
        };
    } else {
        croak('Cannot open ' . $self->{SOURCE_CONFIG_FILE} . ' for reading');
    };
};

sub remove_all_activated_repositories {
    my $self = shift;
    $self->remove_activated_repositories([keys %{$self->{ACTIVATED_REPOSITORIES}}]);
};

sub remove_activated_repositories {
    my $self = shift;
    my $new_repositories_ref = shift;
    push(@{$self->{WARNINGS}}, "\nWARNING: Empty repository list passed for removing from source_config\n") if (!scalar @$new_repositories_ref);
    $self->{VERBOSE} = shift;
    $self->{REMOVE_REPOSITORIES} = {};
    foreach (@$new_repositories_ref) {
        if (!defined ${$self->{ACTIVATED_REPOSITORIES}}{$_}) {
            push (@{$self->{WARNINGS}}, "\nWARNING: repository $_ is not activated in ". $self->get_config_file_default_path()."\n");
        } else {
            ${$self->{REMOVE_REPOSITORIES}}{$_}++;
            delete ${$self->{ACTIVATED_REPOSITORIES}}{$_};
        };
    };
    generate_config_file($self);
};

sub remove_all_activated_modules {
    my $self = shift;
    $self->remove_activated_modules([keys %{$self->{ACTIVATED_MODULES}}]);
};

sub remove_activated_modules {
    my $self = shift;
    my $new_modules_ref = shift;
    push(@{$self->{WARNINGS}}, "\nWARNING: Empty module list passed for removing from source_config\n") if (!scalar @$new_modules_ref);
    $self->{VERBOSE} = shift;
    $self->{REMOVE_MODULES} = {};
    foreach (@$new_modules_ref) {
        if (!defined ${$self->{ACTIVATED_MODULES}}{$_}) {
            push (@{$self->{WARNINGS}}, "\nWARNING: module $_ is not activated in ". $self->get_config_file_default_path()."\n");
        } else {
            ${$self->{REMOVE_MODULES}}{$_}++;
            delete ${$self->{ACTIVATED_MODULES}}{$_};
        };
    };
    generate_config_file($self);
};

sub add_active_repositories {
    my $self = shift;
    $self->{NEW_REPOSITORIES} = shift;
    croak('Empty repository list passed for addition to source_config') if (!scalar @{$self->{NEW_REPOSITORIES}});
    $self->{VERBOSE} = shift;
    foreach (@{$self->{NEW_REPOSITORIES}}) {
        $self->add_repository($_);
    };
    generate_config_file($self);
};

sub add_active_modules {
    my $self = shift;
    my $module_list_ref = shift;
    my $ignored_modules_string = '';
    my @real_modules = ();
    foreach my $module (sort @$module_list_ref) {
        if ($self->get_module_path($module)) {
            push(@real_modules, $module);
        } else {
            $ignored_modules_string .= " $module";
        };
    };
    push (@{$self->{WARNINGS}}, "\nWARNING: following modules are not found in active repositories, and have not been added to the " . $self->get_config_file_default_path() . ":$ignored_modules_string\n") if ($ignored_modules_string);
    $self->{NEW_MODULES} = \@real_modules;
    croak('Empty module list passed for addition to source_config') if (!scalar @{$self->{NEW_MODULES}});
    $self->{VERBOSE} = shift;
    generate_config_file($self);
};

sub add_content {
    my $self = shift;
    my $content = shift;
    my $entries_to_add = shift;
    return if (!scalar @$entries_to_add);
    my $message;
    my $message_part1;
    my $warning_message;
    my $activated_entries;
    
    if ($entries_to_add == $self->{NEW_MODULES}) {
        $self->{NEW_MODULES} = [];
        $message_part1 = "Module(s):\n";
        $activated_entries = $self->{ACTIVATED_MODULES};
    } elsif ($entries_to_add == $self->{NEW_REPOSITORIES}) {
        $self->{NEW_REPOSITORIES} = [];
        $message_part1 = "Repositories:\n";
        $activated_entries = $self->{ACTIVATED_REPOSITORIES};
    };
    foreach my $entry (@$entries_to_add) {
        if (defined $$activated_entries{$entry}) {
            $warning_message .= "$entry "
        } else {
            push(@$content, "$entry=active\n");
            ${$activated_entries}{$entry}++;
            $message .= "$entry "
        };
    };
    
    push(@{$self->{REPORT_MESSAGES}}, "\n$message_part1 $message\nhave been added to the ". $self->get_config_file_default_path()."\n") if ($message);
    push (@{$self->{WARNINGS}}, "\nWARNING: $message_part1 $warning_message\nare already added to the ". $self->get_config_file_default_path()."\n") if ($warning_message);
};

sub generate_config_file {
    my $self = shift;
    my @config_content_new = ();
    my ($module_section, $repository_section);
    my %removed_modules = ();
    my %removed_repositories = ();
    foreach (@{$self->{CONFIG_FILE_CONTENT}}) {
        if (/^\[repositories\]\s*(\s+#)*/) {
            if ($module_section) {
                $self->add_content(\@config_content_new, $self->{NEW_MODULES});
            };
            $module_section = 0;
            $repository_section = 1;
        };
        if (/^\[modules\]\s*(\s+#)*/) {
            if ($repository_section) {
                $self->add_content(\@config_content_new, $self->{NEW_REPOSITORIES});
            };
            $module_section = 1;
            $repository_section = 0;
        };
        if ($module_section && /\s*(\S+)=active\s*(\s+#)*/) {
            if (defined ${$self->{REMOVE_MODULES}}{$1}) {
                $removed_modules{$1}++;
                next;
            };
        }
        if ($repository_section && /\s*(\S+)=active\s*(\s+#)*/) {
            if (defined ${$self->{REMOVE_REPOSITORIES}}{$1}) {
                $removed_repositories{$1}++;
                next;
            };
        }
        push(@config_content_new, $_);
    };
    if (scalar @{$self->{NEW_MODULES}}) {
        push(@config_content_new, "[modules]\n") if (!$module_section);
        $self->add_content(\@config_content_new, $self->{NEW_MODULES});
    };
    if (scalar @{$self->{NEW_REPOSITORIES}}) {
        push(@config_content_new, "[repositories]\n") if (!$repository_section);
        $self->add_content(\@config_content_new, $self->{NEW_REPOSITORIES});
    };
    if (scalar keys %removed_modules) {
        my @deleted_modules = keys %removed_modules;
        push(@{$self->{REPORT_MESSAGES}}, "\nModules: @deleted_modules\nhave been removed from the ". $self->get_config_file_default_path()."\n");
    
    };
    if (scalar keys %removed_repositories) {
        my @deleted_repositories = keys %removed_repositories;
        push(@{$self->{REPORT_MESSAGES}}, "\nRepositories: @deleted_repositories\nhave been removed from the ". $self->get_config_file_default_path()."\n");
    
    };

    # Writing file, printing warnings and reports
    
    #check if we need to write a new file
    my $write_needed = 0;
    if ((scalar @{$self->{CONFIG_FILE_CONTENT}}) != (scalar @config_content_new)) {
        $write_needed++;
    } else {
        foreach my $i (0 .. $#{$self->{CONFIG_FILE_CONTENT}}) {
            if (${$self->{CONFIG_FILE_CONTENT}}[$i] ne $config_content_new[$i]) {
                $write_needed++;
                last;
            };
        };
    };
    if ($write_needed) {
        my $temp_config_file = File::Temp::tmpnam($ENV{TMP});
        die("Cannot open $temp_config_file") if (!open(NEW_CONFIG, ">$temp_config_file"));
        print NEW_CONFIG $_ foreach (@config_content_new);
        close NEW_CONFIG;
        rename($temp_config_file, $self->get_config_file_default_path()) or  system("mv", $temp_config_file, $self->get_config_file_default_path());
        if (-e $temp_config_file) {
            system("rm -rf $temp_config_file") if (!unlink $temp_config_file);
        };
        $self->{CONFIG_FILE_CONTENT} = \@config_content_new;
    };
    if ($self->{VERBOSE}) {
        print $_ foreach (@{$self->{WARNINGS}});
        $self->{VERBOSE} = 0;
    };
    $self->{WARNINGS} = [];
    print $_ foreach (@{$self->{REPORT_MESSAGES}});
    $self->{REPORT_MESSAGES} = [];
};

##### finish #####

1; # needed by use or require

__END__

=head1 NAME

SourceConfig - Perl extension for parsing general info databases

=head1 SYNOPSIS

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

    use SourceConfig;

    # Create a new instance of the parser:
    $a = SourceConfig->new();

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

    # Add a repository new_repository for the actual workspace (via full path):
    $a->add_repository(/DEV300/new_repository);
  
=head1 DESCRIPTION

SourceConfig is a perl extension to load and parse General Info Databses.
It uses a simple object oriented interface to retrieve the information stored
in the database.

Methods:

SourceConfig::new()

Creates a new instance of SourceConfig. Can be initialized by: path to the default repository, path to the source_config, default - empty, the source_config will be taken from the environment


SourceConfig::get_version()

Returns version number of the module. Can't fail.


SourceConfig::get_repositories()

Returns sorted list of active repositories for the actual workspace


SourceConfig::add_repository(REPOSITORY_PATH)

Adds a repository to the list of active repositories


SourceConfig::get_active_modules()

Returns a sorted list of active modules

SourceConfig::get_all_modules()

Returns sorted list of all modules in active repositories.

SourceConfig::get_module_path($module)

Returns absolute module path

SourceConfig::get_module_build_list($module)

Returns absolute module build list path

SourceConfig::get_module_repository($module)

Returns the module's repository

SourceConfig::get_config_file_path()

Returns absolute module to the source configuration file

SourceConfig::get_config_file_default_path()

Returns default path for source configuration file

SourceConfig::is_active()

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

SourceConfig::add_active_modules($module_array_ref)

Adds modules from the @$module_array_ref as active to the source_config file

SourceConfig::add_active_repositories($repository_array_ref)

Adds repositories from the @$repository_array_ref as active to the source_config file

SourceConfig::remove_activated_modules($module_array_ref)

Removes modules from the @$module_array_ref from the source_config file

SourceConfig::remove_all_activated_modules()

Removes all activated modules from the source_config file

SourceConfig::remove_activated_repositories($repository_array_ref)

Removes repositories from the @$repository_array_ref from the source_config file

SourceConfig::remove_all_activated_repositories()

Removes all activated repositories from the source_config file


=head2 EXPORT

SourceConfig::new()
SourceConfig::get_version()
SourceConfig::get_repositories()
SourceConfig::add_repository()
SourceConfig::get_active_modules()
SourceConfig::get_all_modules()
SourceConfig::get_module_path($module)
SourceConfig::get_module_build_list($module)
SourceConfig::get_module_repository($module)
SourceConfig::get_config_file_path()
SourceConfig::get_config_file_default_path()
SourceConfig::is_active($module)
SourceConfig::add_active_modules($module_array_ref)
SourceConfig::add_active_repositories($repository_array_ref)
SourceConfig::remove_activated_modules($module_array_ref)
SourceConfig::remove_all_activated_modules()
SourceConfig::remove_activated_repositories($repository_array_ref)
SourceConfig::remove_all_activated_repositories()

=head1 AUTHOR

Vladimir Glazunov, vg@openoffice.org

=head1 SEE ALSO

perl(1).

=cut