1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
package Local::MrRepo;
# Copyright (C) 2019 Sean Whitton
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use warnings;
use lib "$ENV{HOME}/src/dotfiles/perl5";
use Cwd;
use File::Spec::Functions qw(catfile rel2abs);
use Exporter 'import';
use File::Find;
# Quoting perldoc perlmodlib: "As a general rule, if the module is
# trying to be object oriented then export nothing. If it's just a
# collection of functions then @EXPORT_OK anything but use @EXPORT
# with caution."
our @EXPORT_OK = qw( new_repo );
# Local::MrRepo::Repo::Git and its subclass require non-core
# modules, so we might not be able to load them. If so we'll fall
# back on Local::MrRepo::Repo
#
# ~/bin/locmaint and Local::Homedir use the simpler technique of just
#
# return unless eval "use Foo::Bar; 1";
#
# at the top of functions that require use Foo::Bar. However, for
# MrRepo classes we want to rethrow exceptions (other than import
# failures) to make it easier to debug those classes.
#
# The purpose of wrapping conditional module inclusion in BEGIN is to
# provide subroutine definitions etc. to the compiler as early as
# possible. AFAICT that's not really needed when importing modules
# providing only an OO interface, however, because they don't usually
# export anything at all. That's why the simpler technique suffices
# over in ~/bin/locmaint and Local::Homedir, for Data::Manip and
# Git::Wrapper.
#
# References: Perl Cookbook 12.2, "Trapping Errors in require or use"
# Modern Perl, ch. 8, "Catching Exceptions"
my $have_mrrepo_git; # must not initialise here
BEGIN {
local $@;
eval "require Local::MrRepo::Repo::Git";
if (my $exception = $@) {
die $exception unless $exception =~ /^Can't locate .+ in \@INC/;
$have_mrrepo_git = 0;
} else {
Local::MrRepo::Git->import();
local $@;
eval "require Local::MrRepo::Repo::Git::Annex";
if (my $exception = $@) {
die $exception unless $exception =~ /^Can't locate .+ in \@INC/;
$have_mrrepo_git = 0;
} else {
Local::MrRepo::Git::Annex->import();
$have_mrrepo_git = 1;
}
}
}
sub new_repo {
my $dir = shift;
# This matches git_test in mr(1). That means we don't count bare
# repos, and we're relying on that atm, because ~/lib/nmbug-*
# should be checked using their custom `mr checkout` commands. Maybe
# we should instead be seeing whether `mr config $dir checkout`
# matches /^git clone/, but that means disagreeing with mr(1)
# about which repos are git repos.
if ($have_mrrepo_git && -d catfile($dir, ".git")) {
if (has_annex_objects($dir)) {
return Local::MrRepo::Repo::Git::Annex->new($dir);
} else {
return Local::MrRepo::Repo::Git->new($dir);
}
} else {
return Local::MrRepo::Repo->new($dir);
}
}
sub has_annex_objects {
my $repo = rel2abs(shift);
my $objects_dir = catfile($repo, ".git", "annex", "objects");
return 0 unless -d $objects_dir;
# File::Find::find changes the working directory; undo that
# (no_chdir doesn't seem to be sufficient)
my $cwd = getcwd();
my $found = 0;
find(
sub {
if (-f $File::Find::name) {
$found = 1;
# File::Find does not really support exiting the search
goto MRREPO_DONE_ANNEX_OBJECTS;
}
},
$objects_dir
);
MRREPO_DONE_ANNEX_OBJECTS:
chdir $cwd;
return $found;
}
1;
|
