Converted the 'heads' action to the new model.
[catagits/Gitalist.git] / lib / Gitalist / Git / Project.pm
CommitLineData
56b6dbe6 1use MooseX::Declare;
2
3class Gitalist::Git::Project {
4 # FIXME, use Types::Path::Class and coerce
5 use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
0617cbd0 6 use MooseX::Types::Moose qw/Str Maybe/;
56b6dbe6 7 use DateTime;
8 use Path::Class;
941bb5a1 9 use Gitalist::Git::Util;
a8a8f8f9 10 use aliased 'Gitalist::Git::Object';
56b6dbe6 11
4baaeeef 12 our $SHA1RE = qr/[0-9a-fA-F]{40}/;
29debefd 13
56b6dbe6 14 has name => ( isa => NonEmptySimpleStr,
01ced85b 15 is => 'ro', required => 1 );
56b6dbe6 16 has path => ( isa => "Path::Class::Dir",
01ced85b 17 is => 'ro', required => 1);
56b6dbe6 18
0617cbd0 19 has description => ( isa => Str,
56b6dbe6 20 is => 'ro',
21 lazy_build => 1,
22 );
23 has owner => ( isa => NonEmptySimpleStr,
24 is => 'ro',
25 lazy_build => 1,
26 );
0617cbd0 27 has last_change => ( isa => Maybe['DateTime'],
56b6dbe6 28 is => 'ro',
29 lazy_build => 1,
30 );
941bb5a1 31 has _util => ( isa => 'Gitalist::Git::Util',
32 is => 'ro',
33 lazy_build => 1,
34 handles => [ 'run_cmd' ],
35 );
56b6dbe6 36
01ced85b 37 method BUILD {
38 $self->$_() for qw/_util last_change owner description/; # Ensure to build early.
39 }
40
8dbe8024 41 method _project_dir {
42 -f $self->{path}->file('.git', 'HEAD')
43 ? $self->{path}->subdir('.git')
44 : $self->{path};
45 }
46
941bb5a1 47 method _build__util {
255ee743 48 Gitalist::Git::Util->new(
8dbe8024 49 gitdir => $self->_project_dir($self->path),
941bb5a1 50 );
941bb5a1 51 }
29debefd 52
56b6dbe6 53 method _build_description {
4ce9e8a0 54 my $description = "";
d9a9b56b 55 eval {
56 $description = $self->path->file('description')->slurp;
57 chomp $description;
58 };
56b6dbe6 59 return $description;
60 }
61
62 method _build_owner {
263e2578 63 my ($gecos, $name) = (getpwuid $self->path->stat->uid)[6,0];
64 $gecos =~ s/,+$//;
65 return length($gecos) ? $gecos : $name;
56b6dbe6 66 }
29debefd 67
56b6dbe6 68 method _build_last_change {
69 my $last_change;
70 my $output = $self->run_cmd(
71 qw{ for-each-ref --format=%(committer)
72 --sort=-committerdate --count=1 refs/heads
73 });
74 if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
75 my $dt = DateTime->from_epoch(epoch => $epoch);
76 $dt->set_time_zone($tz);
77 $last_change = $dt;
78 }
79 return $last_change;
80 }
81
8dbe8024 82 method heads {
83 my $cmdout = $self->run_cmd(qw/for-each-ref --sort=-committerdate /, '--format=%(objectname)%00%(refname)%00%(committer)', 'refs/heads');
84 my @output = $cmdout ? split(/\n/, $cmdout) : ();
85 my @ret;
86 for my $line (@output) {
87 my ($rev, $head, $commiter) = split /\0/, $line, 3;
88 $head =~ s!^refs/heads/!!;
89
90 push @ret, { sha1 => $rev, name => $head };
91
92 #FIXME: That isn't the time I'm looking for..
93 if (my ($epoch, $tz) = $line =~ /\s(\d+)\s+([+-]\d+)$/) {
94 my $dt = DateTime->from_epoch(epoch => $epoch);
95 $dt->set_time_zone($tz);
96 $ret[-1]->{last_change} = $dt;
97 }
98 }
99
100 return @ret;
101 }
102
103
4baaeeef 104=head2 head_hash
105
106Find the hash of a given head (defaults to HEAD).
107
108=cut
109
110 method head_hash (Str $head?) {
111 my $output = $self->run_cmd(qw/rev-parse --verify/, $head || 'HEAD' );
112 return unless defined $output;
113
114 my($sha1) = $output =~ /^($SHA1RE)$/;
115 return $sha1;
116 }
117
a8a8f8f9 118=head2 list_tree
119
120Return an array of contents for a given tree.
121The tree is specified by sha1, and defaults to HEAD.
122The keys for each item will be:
123
124 mode
125 type
126 object
127 file
128
129=cut
130
131 method list_tree (Str $sha1?) {
132 $sha1 ||= $self->head_hash;
133
134 my $output = $self->run_cmd(qw/ls-tree -z/, $sha1);
135 return unless defined $output;
136
137 my @ret;
138 for my $line (split /\0/, $output) {
139 my ($mode, $type, $object, $file) = split /\s+/, $line, 4;
140 push @ret, Object->new( mode => oct $mode,
141 type => $type,
142 sha1 => $object,
143 file => $file,
50394a3e 144 project => $self,
a8a8f8f9 145 );
146 }
147 return @ret;
148 }
149
54368e9d 150 use Gitalist::Git::Object;
151 method get_object (Str $sha1) {
152 return Gitalist::Git::Object->new(
153 project => $self,
154 sha1 => $sha1,
155 );
156 }
157
158 # Should be in ::Object
159 method get_object_mode_string (Gitalist::Git::Object $object) {
160 return unless $object && $object->{mode};
161 return $object->{modestr};
162 }
163
164 method get_object_type ($object) {
165 chomp(my $output = $self->run_cmd(qw/cat-file -t/, $object));
166 return unless $output;
167
168 return $output;
169 }
170
171 method cat_file ($object) {
172 my $type = $self->get_object_type($object);
173 die "object `$object' is not a file\n"
174 if (!defined $type || $type ne 'blob');
175
176 my $output = $self->run_cmd(qw/cat-file -p/, $object);
177 return unless $output;
178
179 return $output;
180 }
181
182 method hash_by_path ($base, $path?, $type?) {
183 $path ||= '';
184 $path =~ s{/+$}();
185
186 my $output = $self->run_cmd('ls-tree', $base, '--', $path)
187 or return;
188 my($line) = $output ? split(/\n/, $output) : ();
189
190 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
191 $line =~ m/^([0-9]+) (.+) ($SHA1RE)\t/;
192 return defined $type && $type ne $2
193 ? ()
194 : $3;
195 }
196
197
198
56b6dbe6 199 # Compatibility
200
caba5c95 201=head2 info
56b6dbe6 202
203Returns a hash containing properties of this project. The keys will
204be:
205
206 name
207 description (empty if .git/description is empty/unnamed)
208 owner
209 last_change
210
211=cut
212
caba5c95 213 method info {
56b6dbe6 214 return {
215 name => $self->name,
216 description => $self->description,
217 owner => $self->owner,
218 last_change => $self->last_change,
219 };
220 };
29debefd 221
56b6dbe6 222} # end class