solenv/bin/modules/RepositoryHelper.pm

   1 # -*- Mode: Perl; tab-width: 4; indent-tabs-mode: nil; -*-
   2 #
   3 # This file is part of the LibreOffice project.
   4 #
   5 # This Source Code Form is subject to the terms of the Mozilla Public
   6 # License, v. 2.0. If a copy of the MPL was not distributed with this
   7 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
   8 #
   9 # This file incorporates work covered by the following license notice:
  10 #
  11 #   Licensed to the Apache Software Foundation (ASF) under one or more
  12 #   contributor license agreements. See the NOTICE file distributed
  13 #   with this work for additional information regarding copyright
  14 #   ownership. The ASF licenses this file to you under the Apache
  15 #   License, Version 2.0 (the "License"); you may not use this file
  16 #   except in compliance with the License. You may obtain a copy of
  17 #   the License at http://www.apache.org/licenses/LICENSE-2.0 .
  18 #
  19
  20 #*************************************************************************
  21 #
  22 # RepositoryHelper - Perl for working with repositories
  23 #
  24 # usage: see below
  25 #
  26 #*************************************************************************
  27
  28 package RepositoryHelper;
  29
  30 use strict;
  31
  32
  33 use Carp;
  34 use Cwd qw (cwd);
  35 use File::Basename;
  36 #use File::Temp qw(tmpnam);
  37
  38 my $debug = 0;
  39
  40 #####  profiling #####
  41
  42 ##### ctor #####
  43
  44 sub new {
  45     my $proto = shift;
  46     my $class = ref($proto) || $proto;
  47     my $initial_directory = shift;
  48     if ($initial_directory) {
  49         $initial_directory = Cwd::realpath($initial_directory);
  50     } else {
  51         if ( defined $ENV{PWD} ) {
  52             $initial_directory = $ENV{PWD};
  53         } elsif (defined $ENV{_cwd}) {
  54             $initial_directory = $ENV{_cwd};
  55         } else {
  56             $initial_directory = cwd();
  57         };
  58     };
  59     my $self = {};
  60     $self->{INITIAL_DIRECTORY} = $initial_directory;
  61     $self->{REPOSITORY_ROOT} = undef;
  62     if (! search_via_build_lst($self))
  63     {
  64         croak('Cannot determine source directory/repository for ' . $self->{INITIAL_DIRECTORY});
  65     }
  66     bless($self, $class);
  67     return $self;
  68 }
  69
  70 ##### methods #####
  71 sub get_repository_root
  72 {
  73     my $self        = shift;
  74     return $self->{REPOSITORY_ROOT};
  75 }
  76
  77 sub get_initial_directory
  78 {
  79     my $self        = shift;
  80     return $self->{INITIAL_DIRECTORY};
  81 }
  82
  83 sub search_via_build_lst {
  84     my $self = shift;
  85     my $previous_dir = '';
  86     my $rep_root_candidate = $self->{INITIAL_DIRECTORY};
  87     do {
  88         my $test_file;
  89         if ($rep_root_candidate eq '/') {
  90             $test_file = '/prj/build.lst';
  91         } else {
  92             $test_file = $rep_root_candidate . '/prj/build.lst';
  93         };
  94         if (-e $test_file) {
  95             $self->{REPOSITORY_ROOT} = File::Basename::dirname($rep_root_candidate);
  96             return 1;
  97         };
  98         $previous_dir = $rep_root_candidate;
  99         $rep_root_candidate = File::Basename::dirname($rep_root_candidate);
 100         return 0 if ((!$rep_root_candidate) || ($rep_root_candidate eq $previous_dir));
 101     }
 102     while (chdir "$rep_root_candidate");
 103 };
 104
 105 ##### finish #####
 106
 107 1; # needed by use or require
 108
 109 __END__
 110
 111 =head1 NAME
 112
 113 RepositoryHelper - Perl module for working with repositories
 114
 115 =head1 SYNOPSIS
 116
 117     # example that will analyze sources and return the source root directory
 118
 119     use RepositoryHelper;
 120
 121     # Create a new instance:
 122     $a = RepositoryHelper->new();
 123
 124     # Get repositories for the actual workspace:
 125     $a->get_repository_root();
 126
 127
 128 =head1 DESCRIPTION
 129
 130 RepositoryHelper is a perlPerl module for working with repositories
 131 in the database.
 132
 133 Methods:
 134
 135 RepositoryHelper::new()
 136
 137 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.
 138
 139 RepositoryHelper::get_repository_root()
 140
 141 Returns the repository root, retrieved by educated guess...
 142
 143 RepositoryHelper::get_initial_directory()
 144
 145 Returns full path to the initialistion directory.
 146
 147 =head2 EXPORT
 148
 149 RepositoryHelper::new()
 150 RepositoryHelper::get_repository_root()
 151 RepositoryHelper::get_initial_directory()
 152
 153 =head1 AUTHOR
 154
 155 Vladimir Glazunov, vg@openoffice.org
 156
 157 =head1 SEE ALSO
 158
 159 perl(1).
 160
 161 =cut