#************************************************************** # # 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 # # Unless required by applicable law or agreed to in writing, # software distributed under the License is distributed on an # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY # KIND, either express or implied. See the License for the # specific language governing permissions and limitations # under the License. # #************************************************************** #************************************************************************* # # RepositoryHelper - Perl for working with repositories and underlying SCM # # 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; $self->{REPOSITORY_NAME} = undef; $self->{SCM_NAME} = undef; detect_repository($self); 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 get_scm_name { my $self = shift; return$self->{SCM_NAME}; } ##### private methods ##### sub search_for_hg { my $self = shift; my $hg_root; my $scm_name = 'hg'; if (open(COMMAND, "$scm_name root 2>&1 |")) { foreach () { next if (/^Not trusting file/); chomp; $hg_root = $_; last; }; close COMMAND; chomp $hg_root; if ($hg_root !~ /There is no Mercurial repository here/) { $self->{REPOSITORY_ROOT} = $hg_root; $self->{SCM_NAME} = $scm_name; return 1; }; }; return 0; }; sub search_via_build_lst { my $self = shift; # my @possible_build_lists = ('build.lst', 'build.xlist'); # build lists names my @possible_build_lists = ('build.lst'); # build lists names my $previous_dir = ''; my $rep_root_candidate = $self->{INITIAL_DIRECTORY}; do { foreach (@possible_build_lists) { my $test_file; if ($rep_root_candidate eq '/') { $test_file = '/prj/' . $_; } else { $test_file = $rep_root_candidate . '/prj/' . $_; }; 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(Cwd::realpath($rep_root_candidate)); return 0 if ((!$rep_root_candidate) || ($rep_root_candidate eq $previous_dir)); } while (chdir "$rep_root_candidate"); }; sub detect_repository { my $self = shift; return if (search_via_build_lst($self)); chdir $self->{INITIAL_DIRECTORY}; return if (search_for_hg($self)); croak('Cannot determine source directory/repository for ' . $self->{INITIAL_DIRECTORY}); }; ##### finish ##### 1; # needed by use or require __END__ =head1 NAME RepositoryHelper - Perl module for working with repositories and underlying SCM =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 and underlying SCM 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 SCM methods or on educated guess... RepositoryHelper::get_initial_directory() Returns full path to the initialistion directory. =head2 EXPORT RepositoryHelper::new() RepositoryHelper::get_repository_root() RepositoryHelper::get_scm_name() RepositoryHelper::get_initial_directory() =head1 AUTHOR Vladimir Glazunov, vg@openoffice.org =head1 SEE ALSO perl(1). =cut