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