Adding upstream version 4:7.4.7.upstream/4%7.4.7upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 161 insertions, 0 deletions

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