Change to MX::Declare
[catagits/Gitalist.git] / lib / Gitalist / Git / Project.pm
index 0abb3e7..975483f 100644 (file)
@@ -1,32 +1,16 @@
 use MooseX::Declare;
 
-=head1 NAME
-
-Gitalist::Git::Project - Model of a git repository
-
-=head1 SYNOPSIS
-
-    my $gitrepo = dir('/repo/base/Gitalist');
-    my $project = Gitalist::Git::Project->new($gitrepo);
-     $project->name;        # 'Gitalist'
-     $project->path;        # '/repo/base/Gitalist/.git'
-     $project->description; # 'Unnamed repository.'
-
-=head1 DESCRIPTION
-
-This class models a git repository, referred to in Gitalist
-as a "Project".
-
-=cut
-
 class Gitalist::Git::Project with Gitalist::Git::HasUtils {
     # FIXME, use Types::Path::Class and coerce
     use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
     use MooseX::Types::Path::Class qw/Dir/;
     use MooseX::Types::Moose qw/Str Maybe Bool HashRef ArrayRef/;
+    use Gitalist::Git::Types qw/SHA1/;
     use Moose::Autobox;
     use List::MoreUtils qw/any zip/;
     use DateTime;
+    use Encode qw/decode/;
+    use I18N::Langinfo qw/langinfo CODESET/;
     use Gitalist::Git::Object::Blob;
     use Gitalist::Git::Object::Tree;
     use Gitalist::Git::Object::Commit;
@@ -46,60 +30,27 @@ class Gitalist::Git::Project with Gitalist::Git::HasUtils {
                              path => $dir);
     }
 
-=head1 ATTRIBUTES
-
-=head2 name
-
-The name of the Project.  By default, this is derived from the path to the git repository.
-
-=cut
     has name => ( isa => NonEmptySimpleStr,
                   is => 'ro', required => 1 );
 
-=head2 path
-
-L<Path::Class:Dir> for the location of the git repository.
-
-=cut
     has path => ( isa => Dir,
                   is => 'ro', required => 1);
 
-=head2 description
-
-String containing .git/description
-
-=cut
     has description => ( isa => Str,
                          is => 'ro',
                          lazy_build => 1,
                      );
 
-=head2 owner
-
-Owner of the files on disk.
-
-=cut
     has owner => ( isa => NonEmptySimpleStr,
                    is => 'ro',
                    lazy_build => 1,
                );
 
-=head2 last_change
-
-L<DateTime> for the time of the last update.
-undef if the repository has never been used.
-
-=cut
     has last_change => ( isa => Maybe['DateTime'],
                          is => 'ro',
                          lazy_build => 1,
                      );
 
-=head2 is_bare
-
-Bool indicating whether this Project is bare.
-
-=cut
     has is_bare => ( isa => Bool,
                      is => 'ro',
                      lazy => 1,
@@ -108,29 +59,12 @@ Bool indicating whether this Project is bare.
                              ? 1 : 0
                          },
                      );
-
-=head2 heads
-
-ArrayRef of hashes containing the name and sha1 of all heads.
-
-=cut
     has heads => ( isa => ArrayRef[HashRef],
                    is => 'ro',
                    lazy_build => 1);
-=head2 tags
-
-ArrayRef of hashes containing the name and sha1 of all tags.
-
-=cut
     has tags => ( isa => ArrayRef[HashRef],
                    is => 'ro',
                    lazy_build => 1);
-
-=head2 references
-
-Hashref of ArrayRefs for each reference.
-
-=cut
     has references => ( isa => HashRef[ArrayRef[Str]],
                         is => 'ro',
                         lazy_build => 1 );
@@ -139,13 +73,7 @@ Hashref of ArrayRefs for each reference.
         $self->$_() for qw/last_change owner description/; # Ensure to build early.
     }
 
-=head1 METHODS
-
-=head2 head_hash ($head?)
-
-Return the sha1 for HEAD, or any specified head.
-
-=cut
+    ## Public methods
     method head_hash (Str $head?) {
         my $output = $self->run_cmd(qw/rev-parse --verify/, $head || 'HEAD' );
         confess("No such head: " . $head) unless defined $output;
@@ -154,26 +82,14 @@ Return the sha1 for HEAD, or any specified head.
         return $sha1;
     }
 
-=head2 list_tree ($sha1?)
-
-Return an array of contents for a given tree.
-The tree is specified by sha1, and defaults to HEAD.
-Each item is a L<Gitalist::Git::Object>.
-
-=cut
-    method list_tree (Str $sha1?) {
+    method list_tree (SHA1 $sha1?) {
         $sha1 ||= $self->head_hash;
         my $object = $self->get_object($sha1);
         return @{$object->tree};
     }
 
-=head2 get_object ($sha1)
-
-Return an appropriate subclass of L<Gitalist::Git::Object> for the given sha1.
-
-=cut
     method get_object (NonEmptySimpleStr $sha1) {
-        unless ( $self->_is_valid_rev($sha1) ) {
+        unless (is_SHA1($sha1)) {
             $sha1 = $self->head_hash($sha1);
         }
         my $type = $self->run_cmd('cat-file', '-t', $sha1);
@@ -186,11 +102,6 @@ Return an appropriate subclass of L<Gitalist::Git::Object> for the given sha1.
         );
     }
 
-=head2 hash_by_path($sha1, $path, $type?)
-
-Returns the sha1 for a given path, optionally limited by type.
-
-=cut
     method hash_by_path ($base, $path = '', $type?) {
         $path =~ s{/+$}();
         # FIXME should this really just take the first result?
@@ -205,11 +116,6 @@ Returns the sha1 for a given path, optionally limited by type.
                 : $3;
     }
 
-=head2 list_revs($sha1, $count?, $skip?, \%search?, $file?)
-
-Returns a list of revs for the given head ($sha1).
-
-=cut
     method list_revs ( NonEmptySimpleStr :$sha1!,
                        Int :$count?,
                        Int :$skip?,
@@ -218,7 +124,7 @@ Returns a list of revs for the given head ($sha1).
         $sha1 = $self->head_hash($sha1)
             if !$sha1 || $sha1 !~ $SHA1RE;
 
-       my @search_opts;
+        my @search_opts;
         if ($search) {
             $search->{type} = 'grep'
                 if $search->{type} eq 'commit';
@@ -247,39 +153,25 @@ Returns a list of revs for the given head ($sha1).
         return @revs;
     }
 
-=head2 snapshot($sha1, $format)
-
-Generate an archived snapshot of the repository.
-$sha1 should be a commit or tree.
-Returns a filehandle to read from.
-
-=cut
-
-method snapshot (NonEmptySimpleStr :$sha1,
+    method snapshot (NonEmptySimpleStr :$sha1,
                  NonEmptySimpleStr :$format
                ) {
-    # TODO - only valid formats are 'tar' and 'zip'
-    my $formats = { tgz => 'tar', zip => 'zip' };
-    unless ($formats->exists($format)) {
-        die("No such format: $format");
+        # TODO - only valid formats are 'tar' and 'zip'
+        my $formats = { tgz => 'tar', zip => 'zip' };
+        unless ($formats->exists($format)) {
+            die("No such format: $format");
+        }
+        $format = $formats->{$format};
+        my $name = $self->name;
+        $name =~ s,([^/])/*\.git$,$1,;
+        my $filename = $name;
+        $filename .= "-$sha1.$format";
+        $name =~ s/\047/\047\\\047\047/g;
+
+        my @cmd = ('archive', "--format=$format", "--prefix=$name/", $sha1);
+        return ($filename, $self->run_cmd_fh(@cmd));
+        # TODO - support compressed archives
     }
-    $format = $formats->{$format};
-    my $name = $self->name;
-    $name =~ s,([^/])/*\.git$,$1,;
-    my $filename = $name;
-    $filename .= "-$sha1.$format";
-    $name =~ s/\047/\047\\\047\047/g;
-
-    my @cmd = ('archive', "--format=$format", "--prefix=$name/", $sha1);
-    return ($filename, $self->run_cmd_fh(@cmd));
-    # TODO - support compressed archives
-}
-
-=head2 diff($commit, $patch?, $parent?, $file?)
-
-Generate a diff from a given L<Gitalist::Git::Object>.
-
-=cut
 
     method diff ( Gitalist::Git::Object :$commit!,
                   Bool :$patch?,
@@ -291,13 +183,6 @@ Generate a diff from a given L<Gitalist::Git::Object>.
                                     file => $file);
     }
 
-=head2 reflog(@lorgargs)
-
-Return a list of hashes representing each reflog entry.
-
-FIXME Should this return objects?
-
-=cut
     method reflog (@logargs) {
         my @entries
             =  $self->run_cmd(qw(log -g), @logargs)
@@ -356,7 +241,7 @@ FIXME Should this return objects?
     }
 
     method _build_owner {
-        my ($gecos, $name) = (getpwuid $self->path->stat->uid)[6,0];
+        my ($gecos, $name) = map { decode(langinfo(CODESET), $_) } (getpwuid $self->path->stat->uid)[6,0];
         $gecos =~ s/,+$//;
         return length($gecos) ? $gecos : $name;
     }
@@ -399,12 +284,12 @@ FIXME Should this return objects?
         my @revlines = $self->run_cmd_list('for-each-ref',
           '--sort=-creatordate',
           '--format=%(objectname) %(objecttype) %(refname) %(*objectname) %(*objecttype) %(subject)%00%(creator)',
-         'refs/tags'
+          'refs/tags'
         );
         my @ret;
         for my $line (@revlines) {
             my($refinfo, $creatorinfo) = split /\0/, $line;
-           my($rev, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
+            my($rev, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
             my($creator, $epoch, $tz) = ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
             $name =~ s!^refs/tags/!!;
 
@@ -422,9 +307,9 @@ FIXME Should this return objects?
     }
 
     method _build_references {
-       # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
-       # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
-       my @reflist = $self->run_cmd_list(qw(show-ref --dereference))
+        # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
+        # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
+        my @reflist = $self->run_cmd_list(qw(show-ref --dereference))
             or return;
         my %refs;
         for (@reflist) {
@@ -436,14 +321,10 @@ FIXME Should this return objects?
     }
 
     ## Private methods
-    method _is_valid_rev (Str $rev) {
-        return ($rev =~ /^($SHA1RE)$/);
-    }
-
     method _parse_rev_list ($output) {
         return
             map  $self->get_gpp_object($_),
-                grep $self->_is_valid_rev($_),
+                grep is_SHA1($_),
                     map  split(/\n/, $_, 6), split /\0/, $output;
     }
 
@@ -451,10 +332,107 @@ FIXME Should this return objects?
 
 __END__
 
+=head1 NAME
+
+Gitalist::Git::Project - Model of a git repository
+
+=head1 SYNOPSIS
+
+    my $gitrepo = dir('/repo/base/Gitalist');
+    my $project = Gitalist::Git::Project->new($gitrepo);
+     $project->name;        # 'Gitalist'
+     $project->path;        # '/repo/base/Gitalist/.git'
+     $project->description; # 'Unnamed repository.'
+
+=head1 DESCRIPTION
+
+This class models a git repository, referred to in Gitalist
+as a "Project".
+
+
+=head1 ATTRIBUTES
+
+=head2 name
+
+The name of the Project.  If unspecified, this will be derived from the path to the git repository.
+
+=head2 path
+
+L<Path::Class:Dir> for the filesystem path to the git repository.
+
+=head2 description
+
+The contents of .git/description.
+
+=head2 owner
+
+Owner of the files on the filesystem.
+
+=head2 last_change
+
+The L<DateTime> of the last modification of the repository.  This will be C<undef> if the repository has never been used.
+
+=head2 is_bare
+
+True if this is a bare git repository.
+
+=head2 heads
+
+=head2 tags
+
+An array of the name and sha1 of all heads/tags in the repository.
+
+=head2 references
+
+Hashref of ArrayRefs for each reference.
+
+
+=head1 METHODS
+
+=head2 head_hash ($head?)
+
+Return the sha1 for HEAD, or any specified head.
+
+=head2 list_tree ($sha1?)
+
+Return an array of contents for a given tree.
+The tree is specified by sha1, and defaults to HEAD.
+Each item is a L<Gitalist::Git::Object>.
+
+=head2 get_object ($sha1)
+
+Return an appropriate subclass of L<Gitalist::Git::Object> for the given sha1.
+
+=head2 hash_by_path ($sha1, $path, $type?)
+
+Returns the sha1 for a given path, optionally limited by type.
+
+=head2 list_revs ($sha1, $count?, $skip?, \%search?, $file?)
+
+Returns a list of revs for the given head ($sha1).
+
+=head2 snapshot ($sha1, $format)
+
+Generate an archived snapshot of the repository.
+$sha1 should be a commit or tree.
+Returns a filehandle to read from.
+
+=head2 diff ($commit, $patch?, $parent?, $file?)
+
+Generate a diff from a given L<Gitalist::Git::Object>.
+
+=head2 reflog (@lorgargs)
+
+Return a list of hashes representing each reflog entry.
+
+FIXME Should this return objects?
+
+
 =head1 SEE ALSO
 
 L<Gitalist::Git::Util> L<Gitalist::Git::Object>
 
+
 =head1 AUTHORS
 
 See L<Gitalist> for authors.