solenv/bin/modules/SourceConfig.pm

   1 # -*- Mode: Perl; tab-width: 4; indent-tabs-mode: nil; -*-
   2 #
   3 # This file is part of the LibreOffice project.
   4 #
   5 # This Source Code Form is subject to the terms of the Mozilla Public
   6 # License, v. 2.0. If a copy of the MPL was not distributed with this
   7 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   8 #
   9 # This file incorporates work covered by the following license notice:
  10 #
  11 #   Licensed to the Apache Software Foundation (ASF) under one or more
  12 #   contributor license agreements. See the NOTICE file distributed
  13 #   with this work for additional information regarding copyright
  14 #   ownership. The ASF licenses this file to you under the Apache
  15 #   License, Version 2.0 (the "License"); you may not use this file
  16 #   except in compliance with the License. You may obtain a copy of
  17 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  18 #
  19
  20 #*************************************************************************
  21 #
  22 # SourceConfig - Perl extension for parsing general info databases
  23 #
  24 # usage: see below
  25 #
  26 #*************************************************************************
  27
  28 package SourceConfig;
  29
  30 use strict;
  31
  32 use Carp;
  33 use Cwd;
  34 use RepositoryHelper;
  35 use File::Basename;
  36 use File::Temp qw(tmpnam);
  37
  38 my $debug = 0;
  39
  40 #####  profiling #####
  41
  42 ##### ctor #####
  43
  44 sub new {
  45     my $proto = shift;
  46     my $class = ref($proto) || $proto;
  47     my $source_root = shift;
  48     my @additional_repositories = @_;
  49
  50     my $self = {};
  51     $self->{USER_SOURCE_ROOT} = undef;
  52     if (defined $source_root) {
  53         $source_root = Cwd::realpath($source_root);
  54         $source_root =~ s/\\|\/$//;
  55         $self->{USER_SOURCE_ROOT} = $source_root;
  56         $source_root .= '/..';
  57     }
  58     else
  59     {
  60         $source_root = $ENV{SRC_ROOT};
  61     };
  62     $source_root = Cwd::realpath($source_root);
  63     $self->{SOURCE_ROOT} = $source_root;
  64     $self->{DEBUG} = 0;
  65     $self->{VERBOSE} = 0;
  66     $self->{REPOSITORIES} = {};
  67     $self->{MODULE_PATHS} = {};
  68     $self->{MODULE_REPOSITORY} = {};
  69     $self->{REAL_MODULES} = {};
  70     if (defined $self->{USER_SOURCE_ROOT})
  71     {
  72         ${$self->{REPOSITORIES}}{File::Basename::basename($self->{USER_SOURCE_ROOT})} = $self->{USER_SOURCE_ROOT};
  73     }
  74     else
  75     {
  76         get_fallback_repository($self);
  77     };
  78     foreach my $additional_repository (@additional_repositories)
  79     {
  80         ${$self->{REPOSITORIES}}{File::Basename::basename($additional_repository)} = $additional_repository;
  81     }
  82
  83     get_module_paths($self);
  84     bless($self, $class);
  85     return $self;
  86 }
  87
  88 ##### methods #####
  89
  90 sub get_repositories
  91 {
  92     my $self        = shift;
  93     return sort keys %{$self->{REPOSITORIES}};
  94 }
  95
  96 sub get_module_repository {
  97     my $self = shift;
  98     my $module = shift;
  99     if (defined ${$self->{MODULE_REPOSITORY}}{$module}) {
 100         return ${$self->{MODULE_REPOSITORY}}{$module};
 101     } else {
 102         Carp::cluck("No such module $module in active repositories!!\n");
 103         return undef;
 104     };
 105 }
 106
 107 sub get_module_path {
 108     my $self = shift;
 109     my $module = shift;
 110     if (defined ${$self->{MODULE_PATHS}}{$module}) {
 111         return ${$self->{MODULE_PATHS}}{$module};
 112     } else {
 113         Carp::cluck("No path for module $module in active repositories!!\n");
 114         return undef;
 115     };
 116 }
 117
 118 sub get_all_modules
 119 {
 120     my $self = shift;
 121     my $module = shift;
 122     return sort keys %{$self->{MODULE_PATHS}};
 123 };
 124
 125 sub get_active_modules
 126 {
 127     my $self        = shift;
 128     return sort keys %{$self->{REAL_MODULES}};
 129 }
 130
 131 sub is_active
 132 {
 133     my $self        = shift;
 134     my $module      = shift;
 135     return exists ($self->{REAL_MODULES}{$module});
 136 }
 137
 138 ##### private methods #####
 139
 140 sub get_repository_module_paths {
 141     my $self        = shift;
 142     my $repository        = shift;
 143     my $repository_path = ${$self->{REPOSITORIES}}{$repository};
 144     if (opendir DIRHANDLE, $repository_path) {
 145         foreach my $module (readdir(DIRHANDLE)) {
 146             next if (($module =~ /^\.+/) || (!-d "$repository_path/$module"));
 147             my $module_entry = $module;
 148             if (($module !~ s/\.lnk$//) && ($module !~ s/\.link$//)) {
 149                 $self->{REAL_MODULES}{$module}++;
 150             }
 151             my $possible_path = "$repository_path/$module_entry";
 152             if (-d $possible_path) {
 153                 if (defined ${$self->{MODULE_PATHS}}{$module}) {
 154                     close DIRHANDLE;
 155                     croak("Ambiguous paths for module $module: $possible_path and " . ${$self->{MODULE_PATHS}}{$module});
 156                 };
 157                 ${$self->{MODULE_PATHS}}{$module} = $possible_path;
 158                 ${$self->{MODULE_REPOSITORY}}{$module} = $repository;
 159             }
 160         };
 161         close DIRHANDLE;
 162     } else {
 163         croak("Cannot read $repository_path repository content");
 164     };
 165 };
 166
 167 sub get_module_paths {
 168     my $self        = shift;
 169     foreach my $repository (keys %{$self->{REPOSITORIES}}) {
 170         get_repository_module_paths($self, $repository);
 171     };
 172     croak("No modules found!") if (!scalar keys %{$self->{MODULE_PATHS}});
 173 };
 174
 175 #
 176 # Fallback - fallback repository is based on RepositoryHelper educated guess
 177 #
 178 sub get_fallback_repository {
 179     my $self = shift;
 180     my $repository_root = RepositoryHelper->new()->get_repository_root();
 181     ${$self->{REPOSITORIES}}{File::Basename::basename($repository_root)} = $repository_root;
 182 };
 183
 184 ##### finish #####
 185
 186 1; # needed by use or require
 187