File: Git.pm

package info (click to toggle)
libconfig-gitlike-perl 1.18-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 300 kB
  • sloc: perl: 2,468; makefile: 2
file content (134 lines) | stat: -rw-r--r-- 3,170 bytes parent folder | download | duplicates (2)
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
package Config::GitLike::Git;
use Moo;
use strict;
use warnings;

extends 'Config::GitLike';

has '+confname' => (
    default => 'gitconfig',
);

has '+compatible' => (
    default => 1,
);

sub dir_file {
    my $self = shift;
    return ".git/config" unless @_;
    my $path = shift;
    my $dir = $self->is_git_dir( $path );
    return File::Spec->catfile( $dir, "config" ) if $dir;

    $path = File::Spec->rel2abs( $path );
    return File::Spec->catfile( $path, ".git/config");
}

sub is_git_dir {
    my $self = shift;
    my $path = File::Spec->rel2abs( shift );
    $path =~ s{/+$}{};

    ($path) = grep {-d} map {"$path$_"} (".git/.git", "/.git", ".git", "");
    return unless $path;

    # Has to have objects/ and refs/ directories
    return unless -d "$path/objects" and -d "$path/refs";

    # Has to have a HEAD file
    return unless -f "$path/HEAD";

    if (-l "$path/HEAD" ) {
        # Symbolic link into refs/
        return unless readlink("$path/HEAD") =~ m{^refs/};
    } else {
        open(HEAD, "$path/HEAD") or return;
        my ($line) = <HEAD>;
        close HEAD;
        # Is either 'ref: refs/whatever' or a sha1
        return unless $line =~ m{^(ref:\s*refs/|[0-9a-fA-F]{20})};
    }
    return $path;
}

sub load_dirs {
    my $self = shift;
    my $path = shift;
    my $dir = $self->is_git_dir($path) or return;
    $self->load_file( File::Spec->catfile( $dir, "config" ) );
}

__PACKAGE__->meta->make_immutable;
no Moo;

1;

__END__

=head1 NAME

Config::GitLike::Git - load Git configuration files

=head1 SYNOPSIS

    use Config::GitLike::Git;
    my $config = Config::GitLike::Git->new;
    $config->load("/path/to/repo");

=head1 DESCRIPTION

This is a modification of L<Config::GitLike> to look at the same
locations that Git writes to. Unlike with L<Config::GitLike>, you do
not need to pass a confname to its constructor. This module also
enables the L<Config::GitLike> option to maintain git compatibility
when reading and writing variables.

L<Config::GitLike/load> should be passed path to the top level of a
git repository -- this defaults to the current directory.  It will
append C<.git> as necessary.  It supports both bare and non-bare
repositories.

=head1 METHODS

This module overrides these methods from C<Config::GitLike>:

=head2 dir_file

The per-directory configuration file is F<.git/config>.  With an
optional directory argument, will return a fully-qualified path to the
configuration file, as git would edit with C<git config --local -C path>.

=head2 user_file

The per-user configuration file is F<~/.gitconfig>

=head2 global_file

The per-host configuration file is F</etc/gitconfig>

=head2 is_git_dir

Returns true if a file contains the necessary files (as git would reckon
it) for the path to be a git repository.

=head2 load_dirs

Loads the relevant .git/config file.

=head1 SEE ALSO

L<Config::GitLike|Config::GitLike>

=head1 LICENSE

You may modify and/or redistribute this software under the same terms
as Perl 5.8.8.

=head1 COPYRIGHT

Copyright 2010 Best Practical Solutions, LLC

=head1 AUTHORS

Alex Vandiver <alexmv@bestpractical.com>,
Christine Spang <spang@bestpractical.com>