From ed5640d8b587fbcfed7dd7967f3de04b37a76f26 Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 7 Apr 2024 11:06:44 +0200 Subject: Adding upstream version 4:7.4.7. Signed-off-by: Daniel Baumann --- solenv/bin/modules/RepositoryHelper.pm | 161 +++++++++++++++++++++++++++++++++ 1 file changed, 161 insertions(+) create mode 100644 solenv/bin/modules/RepositoryHelper.pm (limited to 'solenv/bin/modules/RepositoryHelper.pm') diff --git a/solenv/bin/modules/RepositoryHelper.pm b/solenv/bin/modules/RepositoryHelper.pm new file mode 100644 index 000000000..29001f178 --- /dev/null +++ b/solenv/bin/modules/RepositoryHelper.pm @@ -0,0 +1,161 @@ +# -*- Mode: Perl; tab-width: 4; indent-tabs-mode: nil; -*- +# +# This file is part of the LibreOffice project. +# +# This Source Code Form is subject to the terms of the Mozilla Public +# License, v. 2.0. If a copy of the MPL was not distributed with this +# file, You can obtain one at http://mozilla.org/MPL/2.0/. +# +# This file incorporates work covered by the following license notice: +# +# 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 . +# + +#************************************************************************* +# +# RepositoryHelper - Perl for working with repositories +# +# usage: see below +# +#************************************************************************* + +package RepositoryHelper; + +use strict; + + +use Carp; +use Cwd qw (cwd); +use File::Basename; +#use File::Temp qw(tmpnam); + +my $debug = 0; + +##### profiling ##### + +##### ctor ##### + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $initial_directory = shift; + if ($initial_directory) { + $initial_directory = Cwd::realpath($initial_directory); + } else { + if ( defined $ENV{PWD} ) { + $initial_directory = $ENV{PWD}; + } elsif (defined $ENV{_cwd}) { + $initial_directory = $ENV{_cwd}; + } else { + $initial_directory = cwd(); + }; + }; + my $self = {}; + $self->{INITIAL_DIRECTORY} = $initial_directory; + $self->{REPOSITORY_ROOT} = undef; + if (! search_via_build_lst($self)) + { + croak('Cannot determine source directory/repository for ' . $self->{INITIAL_DIRECTORY}); + } + bless($self, $class); + return $self; +} + +##### methods ##### +sub get_repository_root +{ + my $self = shift; + return $self->{REPOSITORY_ROOT}; +} + +sub get_initial_directory +{ + my $self = shift; + return $self->{INITIAL_DIRECTORY}; +} + +sub search_via_build_lst { + my $self = shift; + my $previous_dir = ''; + my $rep_root_candidate = $self->{INITIAL_DIRECTORY}; + do { + my $test_file; + if ($rep_root_candidate eq '/') { + $test_file = '/prj/build.lst'; + } else { + $test_file = $rep_root_candidate . '/prj/build.lst'; + }; + if (-e $test_file) { + $self->{REPOSITORY_ROOT} = File::Basename::dirname($rep_root_candidate); + return 1; + }; + $previous_dir = $rep_root_candidate; + $rep_root_candidate = File::Basename::dirname($rep_root_candidate); + return 0 if ((!$rep_root_candidate) || ($rep_root_candidate eq $previous_dir)); + } + while (chdir "$rep_root_candidate"); +}; + +##### finish ##### + +1; # needed by use or require + +__END__ + +=head1 NAME + +RepositoryHelper - Perl module for working with repositories + +=head1 SYNOPSIS + + # example that will analyze sources and return the source root directory + + use RepositoryHelper; + + # Create a new instance: + $a = RepositoryHelper->new(); + + # Get repositories for the actual workspace: + $a->get_repository_root(); + + +=head1 DESCRIPTION + +RepositoryHelper is a perlPerl module for working with repositories +in the database. + +Methods: + +RepositoryHelper::new() + +Creates a new instance of RepositoryHelper. Can be initialized by: some path which likely to belong to a repository, default - empty, the current dir will be taken. + +RepositoryHelper::get_repository_root() + +Returns the repository root, retrieved by educated guess... + +RepositoryHelper::get_initial_directory() + +Returns full path to the initialisation directory. + +=head2 EXPORT + +RepositoryHelper::new() +RepositoryHelper::get_repository_root() +RepositoryHelper::get_initial_directory() + +=head1 AUTHOR + +Vladimir Glazunov, vg@openoffice.org + +=head1 SEE ALSO + +perl(1). + +=cut -- cgit v1.2.3