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# RepositoryHelper - Perl for working with repositories 23# 24# usage: see below 25# 26#************************************************************************* 27 28package RepositoryHelper; 29 30use strict; 31 32 33use Carp; 34use Cwd qw (cwd); 35use File::Basename; 36#use File::Temp qw(tmpnam); 37 38my $debug = 0; 39 40##### profiling ##### 41 42##### ctor ##### 43 44sub new { 45 my $proto = shift; 46 my $class = ref($proto) || $proto; 47 my $initial_directory = shift; 48 if ($initial_directory) { 49 $initial_directory = Cwd::realpath($initial_directory); 50 } else { 51 if ( defined $ENV{PWD} ) { 52 $initial_directory = $ENV{PWD}; 53 } elsif (defined $ENV{_cwd}) { 54 $initial_directory = $ENV{_cwd}; 55 } else { 56 $initial_directory = cwd(); 57 }; 58 }; 59 my $self = {}; 60 $self->{INITIAL_DIRECTORY} = $initial_directory; 61 $self->{REPOSITORY_ROOT} = undef; 62 if (! search_via_build_lst($self)) 63 { 64 croak('Cannot determine source directory/repository for ' . $self->{INITIAL_DIRECTORY}); 65 } 66 bless($self, $class); 67 return $self; 68} 69 70##### methods ##### 71sub get_repository_root 72{ 73 my $self = shift; 74 return $self->{REPOSITORY_ROOT}; 75} 76 77sub get_initial_directory 78{ 79 my $self = shift; 80 return $self->{INITIAL_DIRECTORY}; 81} 82 83sub search_via_build_lst { 84 my $self = shift; 85 my $previous_dir = ''; 86 my $rep_root_candidate = $self->{INITIAL_DIRECTORY}; 87 do { 88 my $test_file; 89 if ($rep_root_candidate eq '/') { 90 $test_file = '/prj/build.lst'; 91 } else { 92 $test_file = $rep_root_candidate . '/prj/build.lst'; 93 }; 94 if (-e $test_file) { 95 $self->{REPOSITORY_ROOT} = File::Basename::dirname($rep_root_candidate); 96 return 1; 97 }; 98 $previous_dir = $rep_root_candidate; 99 $rep_root_candidate = File::Basename::dirname($rep_root_candidate); 100 return 0 if ((!$rep_root_candidate) || ($rep_root_candidate eq $previous_dir)); 101 } 102 while (chdir "$rep_root_candidate"); 103}; 104 105##### finish ##### 106 1071; # needed by use or require 108 109__END__ 110 111=head1 NAME 112 113RepositoryHelper - Perl module for working with repositories 114 115=head1 SYNOPSIS 116 117 # example that will analyze sources and return the source root directory 118 119 use RepositoryHelper; 120 121 # Create a new instance: 122 $a = RepositoryHelper->new(); 123 124 # Get repositories for the actual workspace: 125 $a->get_repository_root(); 126 127 128=head1 DESCRIPTION 129 130RepositoryHelper is a perlPerl module for working with repositories 131in the database. 132 133Methods: 134 135RepositoryHelper::new() 136 137Creates 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. 138 139RepositoryHelper::get_repository_root() 140 141Returns the repository root, retrieved by educated guess... 142 143RepositoryHelper::get_initial_directory() 144 145Returns full path to the initialisation directory. 146 147=head2 EXPORT 148 149RepositoryHelper::new() 150RepositoryHelper::get_repository_root() 151RepositoryHelper::get_initial_directory() 152 153=head1 AUTHOR 154 155Vladimir Glazunov, vg@openoffice.org 156 157=head1 SEE ALSO 158 159perl(1). 160 161=cut 162