Change from string to bareword types, and add a Maybe in Gitalist/Git/Project as...
[catagits/Gitalist.git] / lib / Gitalist / Git / Project.pm
1 use MooseX::Declare;
2
3 class Gitalist::Git::Project {
4     # FIXME, use Types::Path::Class and coerce
5     use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
6     use MooseX::Types::Moose qw/Str Maybe/;
7     use DateTime;
8     use Path::Class;
9     use Gitalist::Git::Util;
10     use aliased 'Gitalist::Git::Object';
11
12     our $SHA1RE = qr/[0-9a-fA-F]{40}/;
13     
14     has name => ( isa => NonEmptySimpleStr,
15                   is => 'ro' );
16     has path => ( isa => "Path::Class::Dir",
17                   is => 'ro');
18
19     has description => ( isa => Str,
20                          is => 'ro',
21                          lazy_build => 1,
22                      );
23     has owner => ( isa => NonEmptySimpleStr,
24                    is => 'ro',
25                    lazy_build => 1,
26                );
27     has last_change => ( isa => Maybe['DateTime'],
28                          is => 'ro',
29                          lazy_build => 1,
30                      );
31     has _util => ( isa => 'Gitalist::Git::Util',
32                    is => 'ro',
33                    lazy_build => 1,
34                    handles => [ 'run_cmd' ],
35                );
36
37     method _build__util {
38         my $util = Gitalist::Git::Util->new(
39             gitdir => $self->project_dir($self->path),
40         );
41         return $util;
42     }
43     
44     method _build_description {
45         my $description = "";
46         eval {
47             $description = $self->path->file('description')->slurp;
48             chomp $description;
49         };
50         return $description;
51     }
52
53     method _build_owner {
54         my $owner = (getpwuid $self->path->stat->uid)[6];
55         $owner =~ s/,+$//;
56         return $owner;
57     }
58     
59     method _build_last_change {
60         my $last_change;
61         my $output = $self->run_cmd(
62             qw{ for-each-ref --format=%(committer)
63                 --sort=-committerdate --count=1 refs/heads
64           });
65         if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
66             my $dt = DateTime->from_epoch(epoch => $epoch);
67             $dt->set_time_zone($tz);
68             $last_change = $dt;
69         }
70         return $last_change;
71     }
72
73 =head2 head_hash
74
75 Find the hash of a given head (defaults to HEAD).
76
77 =cut
78
79     method head_hash (Str $head?) {
80         my $output = $self->run_cmd(qw/rev-parse --verify/, $head || 'HEAD' );
81         return unless defined $output;
82
83         my($sha1) = $output =~ /^($SHA1RE)$/;
84         return $sha1;
85     }
86
87 =head2 list_tree
88
89 Return an array of contents for a given tree.
90 The tree is specified by sha1, and defaults to HEAD.
91 The keys for each item will be:
92
93         mode
94         type
95         object
96         file
97
98 =cut
99
100     method list_tree (Str $sha1?) {
101         $sha1 ||= $self->head_hash;
102
103         my $output = $self->run_cmd(qw/ls-tree -z/, $sha1);
104         return unless defined $output;
105
106         my @ret;
107         for my $line (split /\0/, $output) {
108             my ($mode, $type, $object, $file) = split /\s+/, $line, 4;
109             push @ret, Object->new( mode => oct $mode,
110                                     type => $type,
111                                     sha1 => $object,
112                                     file => $file,
113                                     project => $self,
114                                   );
115         }
116         return @ret;
117     }
118
119
120     method project_dir {
121         my $dir = $self->path->stringify;
122         $dir .= '/.git'
123             if -f dir($dir)->file('.git/HEAD');
124         return $dir;
125     }
126
127     # Compatibility
128
129 =head2 info
130
131 Returns a hash containing properties of this project. The keys will
132 be:
133
134         name
135         description (empty if .git/description is empty/unnamed)
136         owner
137         last_change
138
139 =cut
140
141     method info {
142         return {
143             name => $self->name,
144             description => $self->description,
145             owner => $self->owner,
146             last_change => $self->last_change,
147         };
148     };
149     
150 } # end class