1#************************************************************************* 2# 3# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 4# 5# Copyright 2000, 2010 Oracle and/or its affiliates. 6# 7# OpenOffice.org - a multi-platform office productivity suite 8# 9# This file is part of OpenOffice.org. 10# 11# OpenOffice.org is free software: you can redistribute it and/or modify 12# it under the terms of the GNU Lesser General Public License version 3 13# only, as published by the Free Software Foundation. 14# 15# OpenOffice.org is distributed in the hope that it will be useful, 16# but WITHOUT ANY WARRANTY; without even the implied warranty of 17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18# GNU Lesser General Public License version 3 for more details 19# (a copy is included in the LICENSE file that accompanied this code). 20# 21# You should have received a copy of the GNU Lesser General Public License 22# version 3 along with OpenOffice.org. If not, see 23# <http://www.openoffice.org/license.html> 24# for a copy of the LGPLv3 License. 25# 26#************************************************************************* 27 28#************************************************************************* 29# 30# RepositoryHelper - Perl for working with repositories and underlying SCM 31# 32# usage: see below 33# 34#************************************************************************* 35 36package RepositoryHelper; 37 38use strict; 39 40 41use Carp; 42use Cwd qw (cwd); 43use File::Basename; 44#use File::Temp qw(tmpnam); 45 46my $debug = 0; 47 48##### profiling ##### 49 50##### ctor ##### 51 52sub new { 53 my $proto = shift; 54 my $class = ref($proto) || $proto; 55 my $initial_directory = shift; 56 if ($initial_directory) { 57 $initial_directory = Cwd::realpath($initial_directory); 58 } else { 59 if ( defined $ENV{PWD} ) { 60 $initial_directory = $ENV{PWD}; 61 } elsif (defined $ENV{_cwd}) { 62 $initial_directory = $ENV{_cwd}; 63 } else { 64 $initial_directory = cwd(); 65 }; 66 }; 67 my $self = {}; 68 $self->{INITIAL_DIRECTORY} = $initial_directory; 69 $self->{REPOSITORY_ROOT} = undef; 70 $self->{REPOSITORY_NAME} = undef; 71 $self->{SCM_NAME} = undef; 72 detect_repository($self); 73 bless($self, $class); 74 return $self; 75} 76 77##### methods ##### 78sub get_repository_root 79{ 80 my $self = shift; 81 return $self->{REPOSITORY_ROOT}; 82} 83 84sub get_initial_directory 85{ 86 my $self = shift; 87 return $self->{INITIAL_DIRECTORY}; 88} 89 90sub get_scm_name 91{ 92 my $self = shift; 93 return$self->{SCM_NAME}; 94} 95 96##### private methods ##### 97sub search_for_hg { 98 my $self = shift; 99 my $hg_root; 100 my $scm_name = 'hg'; 101 if (open(COMMAND, "$scm_name root 2>&1 |")) { 102 foreach (<COMMAND>) { 103 next if (/^Not trusting file/); 104 chomp; 105 $hg_root = $_; 106 last; 107 }; 108 close COMMAND; 109 chomp $hg_root; 110 if ($hg_root !~ /There is no Mercurial repository here/) { 111 $self->{REPOSITORY_ROOT} = $hg_root; 112 $self->{SCM_NAME} = $scm_name; 113 return 1; 114 }; 115 }; 116 return 0; 117}; 118 119sub search_via_build_lst { 120 my $self = shift; 121# my @possible_build_lists = ('build.lst', 'build.xlist'); # build lists names 122 my @possible_build_lists = ('build.lst'); # build lists names 123 my $previous_dir = ''; 124 my $rep_root_candidate = $self->{INITIAL_DIRECTORY}; 125 do { 126 foreach (@possible_build_lists) { 127 my $test_file; 128 if ($rep_root_candidate eq '/') { 129 $test_file = '/prj/' . $_; 130 } else { 131 $test_file = $rep_root_candidate . '/prj/' . $_; 132 }; 133 if (-e $test_file) { 134 $self->{REPOSITORY_ROOT} = File::Basename::dirname($rep_root_candidate); 135 return 1; 136 }; 137 }; 138 $previous_dir = $rep_root_candidate; 139 $rep_root_candidate = File::Basename::dirname(Cwd::realpath($rep_root_candidate)); 140 return 0 if ((!$rep_root_candidate) || ($rep_root_candidate eq $previous_dir)); 141 } 142 while (chdir "$rep_root_candidate"); 143}; 144 145sub detect_repository { 146 my $self = shift; 147 return if (search_via_build_lst($self)); 148 chdir $self->{INITIAL_DIRECTORY}; 149 return if (search_for_hg($self)); 150 croak('Cannot determine source directory/repository for ' . $self->{INITIAL_DIRECTORY}); 151}; 152 153##### finish ##### 154 1551; # needed by use or require 156 157__END__ 158 159=head1 NAME 160 161RepositoryHelper - Perl module for working with repositories and underlying SCM 162 163=head1 SYNOPSIS 164 165 # example that will analyze sources and return the source root directory 166 167 use RepositoryHelper; 168 169 # Create a new instance: 170 $a = RepositoryHelper->new(); 171 172 # Get repositories for the actual workspace: 173 $a->get_repository_root(); 174 175 176=head1 DESCRIPTION 177 178RepositoryHelper is a perlPerl module for working with repositories and underlying SCM 179in the database. 180 181Methods: 182 183RepositoryHelper::new() 184 185Creates 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. 186 187RepositoryHelper::get_repository_root() 188 189Returns the repository root, retrieved by SCM methods or on educated guess... 190 191RepositoryHelper::get_initial_directory() 192 193Returns full path to the initialistion directory. 194 195=head2 EXPORT 196 197RepositoryHelper::new() 198RepositoryHelper::get_repository_root() 199RepositoryHelper::get_scm_name() 200RepositoryHelper::get_initial_directory() 201 202=head1 AUTHOR 203 204Vladimir Glazunov, vg@openoffice.org 205 206=head1 SEE ALSO 207 208perl(1). 209 210=cut 211