solenv/bin/modules/RepositoryHelper.pm

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