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