161 lines
4 KiB
Perl
161 lines
4 KiB
Perl
# -*- 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
|