1*9780544fSAndrew Rist#**************************************************************
2*9780544fSAndrew Rist#
3*9780544fSAndrew Rist#  Licensed to the Apache Software Foundation (ASF) under one
4*9780544fSAndrew Rist#  or more contributor license agreements.  See the NOTICE file
5*9780544fSAndrew Rist#  distributed with this work for additional information
6*9780544fSAndrew Rist#  regarding copyright ownership.  The ASF licenses this file
7*9780544fSAndrew Rist#  to you under the Apache License, Version 2.0 (the
8*9780544fSAndrew Rist#  "License"); you may not use this file except in compliance
9*9780544fSAndrew Rist#  with the License.  You may obtain a copy of the License at
10*9780544fSAndrew Rist#
11*9780544fSAndrew Rist#    http://www.apache.org/licenses/LICENSE-2.0
12*9780544fSAndrew Rist#
13*9780544fSAndrew Rist#  Unless required by applicable law or agreed to in writing,
14*9780544fSAndrew Rist#  software distributed under the License is distributed on an
15*9780544fSAndrew Rist#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16*9780544fSAndrew Rist#  KIND, either express or implied.  See the License for the
17*9780544fSAndrew Rist#  specific language governing permissions and limitations
18*9780544fSAndrew Rist#  under the License.
19*9780544fSAndrew Rist#
20*9780544fSAndrew Rist#**************************************************************
21*9780544fSAndrew Rist
22*9780544fSAndrew Rist
23cdf0e10cSrcweir
24cdf0e10cSrcweir#*************************************************************************
25cdf0e10cSrcweir#
26cdf0e10cSrcweir# RepositoryHelper - Perl for working with repositories and underlying SCM
27cdf0e10cSrcweir#
28cdf0e10cSrcweir# usage: see below
29cdf0e10cSrcweir#
30cdf0e10cSrcweir#*************************************************************************
31cdf0e10cSrcweir
32cdf0e10cSrcweirpackage RepositoryHelper;
33cdf0e10cSrcweir
34cdf0e10cSrcweiruse strict;
35cdf0e10cSrcweir
36cdf0e10cSrcweir
37cdf0e10cSrcweiruse Carp;
38cdf0e10cSrcweiruse Cwd qw (cwd);
39cdf0e10cSrcweiruse File::Basename;
40cdf0e10cSrcweir#use File::Temp qw(tmpnam);
41cdf0e10cSrcweir
42cdf0e10cSrcweirmy $debug = 0;
43cdf0e10cSrcweir
44cdf0e10cSrcweir#####  profiling #####
45cdf0e10cSrcweir
46cdf0e10cSrcweir##### ctor #####
47cdf0e10cSrcweir
48cdf0e10cSrcweirsub new {
49cdf0e10cSrcweir    my $proto = shift;
50cdf0e10cSrcweir    my $class = ref($proto) || $proto;
51cdf0e10cSrcweir    my $initial_directory = shift;
52cdf0e10cSrcweir    if ($initial_directory) {
53cdf0e10cSrcweir        $initial_directory = Cwd::realpath($initial_directory);
54cdf0e10cSrcweir    } else {
55cdf0e10cSrcweir        if ( defined $ENV{PWD} ) {
56cdf0e10cSrcweir            $initial_directory = $ENV{PWD};
57cdf0e10cSrcweir        } elsif (defined $ENV{_cwd}) {
58cdf0e10cSrcweir            $initial_directory = $ENV{_cwd};
59cdf0e10cSrcweir        } else {
60cdf0e10cSrcweir            $initial_directory = cwd();
61cdf0e10cSrcweir        };
62cdf0e10cSrcweir    };
63cdf0e10cSrcweir    my $self = {};
64cdf0e10cSrcweir    $self->{INITIAL_DIRECTORY} = $initial_directory;
65cdf0e10cSrcweir    $self->{REPOSITORY_ROOT} = undef;
66cdf0e10cSrcweir    $self->{REPOSITORY_NAME} = undef;
67cdf0e10cSrcweir    $self->{SCM_NAME} = undef;
68cdf0e10cSrcweir    detect_repository($self);
69cdf0e10cSrcweir    bless($self, $class);
70cdf0e10cSrcweir    return $self;
71cdf0e10cSrcweir}
72cdf0e10cSrcweir
73cdf0e10cSrcweir##### methods #####
74cdf0e10cSrcweirsub get_repository_root
75cdf0e10cSrcweir{
76cdf0e10cSrcweir    my $self        = shift;
77cdf0e10cSrcweir    return $self->{REPOSITORY_ROOT};
78cdf0e10cSrcweir}
79cdf0e10cSrcweir
80cdf0e10cSrcweirsub get_initial_directory
81cdf0e10cSrcweir{
82cdf0e10cSrcweir    my $self        = shift;
83cdf0e10cSrcweir    return $self->{INITIAL_DIRECTORY};
84cdf0e10cSrcweir}
85cdf0e10cSrcweir
86cdf0e10cSrcweirsub get_scm_name
87cdf0e10cSrcweir{
88cdf0e10cSrcweir    my $self        = shift;
89cdf0e10cSrcweir    return$self->{SCM_NAME};
90cdf0e10cSrcweir}
91cdf0e10cSrcweir
92cdf0e10cSrcweir##### private methods #####
93cdf0e10cSrcweirsub search_for_hg {
94cdf0e10cSrcweir    my $self        = shift;
95cdf0e10cSrcweir    my $hg_root;
96cdf0e10cSrcweir    my $scm_name = 'hg';
97cdf0e10cSrcweir    if (open(COMMAND, "$scm_name root 2>&1 |")) {
98cdf0e10cSrcweir        foreach (<COMMAND>) {
99cdf0e10cSrcweir            next if (/^Not trusting file/);
100cdf0e10cSrcweir            chomp;
101cdf0e10cSrcweir            $hg_root = $_;
102cdf0e10cSrcweir            last;
103cdf0e10cSrcweir        };
104cdf0e10cSrcweir        close COMMAND;
105cdf0e10cSrcweir        chomp $hg_root;
106cdf0e10cSrcweir        if ($hg_root !~ /There is no Mercurial repository here/) {
107cdf0e10cSrcweir            $self->{REPOSITORY_ROOT} = $hg_root;
108cdf0e10cSrcweir            $self->{SCM_NAME} = $scm_name;
109cdf0e10cSrcweir            return 1;
110cdf0e10cSrcweir        };
111cdf0e10cSrcweir    };
112cdf0e10cSrcweir    return 0;
113cdf0e10cSrcweir};
114cdf0e10cSrcweir
115cdf0e10cSrcweirsub search_via_build_lst {
116cdf0e10cSrcweir    my $self = shift;
117cdf0e10cSrcweir#    my @possible_build_lists = ('build.lst', 'build.xlist'); # build lists names
118cdf0e10cSrcweir    my @possible_build_lists = ('build.lst'); # build lists names
119cdf0e10cSrcweir    my $previous_dir = '';
120cdf0e10cSrcweir    my $rep_root_candidate = $self->{INITIAL_DIRECTORY};
121cdf0e10cSrcweir    do {
122cdf0e10cSrcweir        foreach (@possible_build_lists) {
123cdf0e10cSrcweir            my $test_file;
124cdf0e10cSrcweir            if ($rep_root_candidate eq '/') {
125cdf0e10cSrcweir                $test_file = '/prj/' . $_;
126cdf0e10cSrcweir            } else {
127cdf0e10cSrcweir                $test_file = $rep_root_candidate . '/prj/' . $_;
128cdf0e10cSrcweir            };
129cdf0e10cSrcweir            if (-e $test_file) {
130cdf0e10cSrcweir                $self->{REPOSITORY_ROOT} = File::Basename::dirname($rep_root_candidate);
131cdf0e10cSrcweir                return 1;
132cdf0e10cSrcweir            };
133cdf0e10cSrcweir        };
134cdf0e10cSrcweir        $previous_dir = $rep_root_candidate;
135cdf0e10cSrcweir        $rep_root_candidate = File::Basename::dirname(Cwd::realpath($rep_root_candidate));
136cdf0e10cSrcweir        return 0 if ((!$rep_root_candidate) || ($rep_root_candidate eq $previous_dir));
137cdf0e10cSrcweir    }
138cdf0e10cSrcweir    while (chdir "$rep_root_candidate");
139cdf0e10cSrcweir};
140cdf0e10cSrcweir
141cdf0e10cSrcweirsub detect_repository {
142cdf0e10cSrcweir    my $self        = shift;
143cdf0e10cSrcweir    return if (search_via_build_lst($self));
144cdf0e10cSrcweir    chdir $self->{INITIAL_DIRECTORY};
145cdf0e10cSrcweir    return if (search_for_hg($self));
146cdf0e10cSrcweir    croak('Cannot determine source directory/repository for ' . $self->{INITIAL_DIRECTORY});
147cdf0e10cSrcweir};
148cdf0e10cSrcweir
149cdf0e10cSrcweir##### finish #####
150cdf0e10cSrcweir
151cdf0e10cSrcweir1; # needed by use or require
152cdf0e10cSrcweir
153cdf0e10cSrcweir__END__
154cdf0e10cSrcweir
155cdf0e10cSrcweir=head1 NAME
156cdf0e10cSrcweir
157cdf0e10cSrcweirRepositoryHelper - Perl module for working with repositories and underlying SCM
158cdf0e10cSrcweir
159cdf0e10cSrcweir=head1 SYNOPSIS
160cdf0e10cSrcweir
161cdf0e10cSrcweir    # example that will analyze sources and return the source root directory
162cdf0e10cSrcweir
163cdf0e10cSrcweir    use RepositoryHelper;
164cdf0e10cSrcweir
165cdf0e10cSrcweir    # Create a new instance:
166cdf0e10cSrcweir    $a = RepositoryHelper->new();
167cdf0e10cSrcweir
168cdf0e10cSrcweir    # Get repositories for the actual workspace:
169cdf0e10cSrcweir    $a->get_repository_root();
170cdf0e10cSrcweir
171cdf0e10cSrcweir
172cdf0e10cSrcweir=head1 DESCRIPTION
173cdf0e10cSrcweir
174cdf0e10cSrcweirRepositoryHelper is a perlPerl module for working with repositories and underlying SCM
175cdf0e10cSrcweirin the database.
176cdf0e10cSrcweir
177cdf0e10cSrcweirMethods:
178cdf0e10cSrcweir
179cdf0e10cSrcweirRepositoryHelper::new()
180cdf0e10cSrcweir
181cdf0e10cSrcweirCreates 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.
182cdf0e10cSrcweir
183cdf0e10cSrcweirRepositoryHelper::get_repository_root()
184cdf0e10cSrcweir
185cdf0e10cSrcweirReturns the repository root, retrieved by SCM methods or on educated guess...
186cdf0e10cSrcweir
187cdf0e10cSrcweirRepositoryHelper::get_initial_directory()
188cdf0e10cSrcweir
189cdf0e10cSrcweirReturns full path to the initialistion directory.
190cdf0e10cSrcweir
191cdf0e10cSrcweir=head2 EXPORT
192cdf0e10cSrcweir
193cdf0e10cSrcweirRepositoryHelper::new()
194cdf0e10cSrcweirRepositoryHelper::get_repository_root()
195cdf0e10cSrcweirRepositoryHelper::get_scm_name()
196cdf0e10cSrcweirRepositoryHelper::get_initial_directory()
197cdf0e10cSrcweir
198cdf0e10cSrcweir=head1 AUTHOR
199cdf0e10cSrcweir
200cdf0e10cSrcweirVladimir Glazunov, vg@openoffice.org
201cdf0e10cSrcweir
202cdf0e10cSrcweir=head1 SEE ALSO
203cdf0e10cSrcweir
204cdf0e10cSrcweirperl(1).
205cdf0e10cSrcweir
206cdf0e10cSrcweir=cut
207