Two kludges to get Gitalist *running* on Strawberry Perl.
[catagits/Gitalist.git] / lib / Gitalist / Git / Object.pm
1 use MooseX::Declare;
2 use Moose::Autobox;
3
4 class Gitalist::Git::Object {
5     use MooseX::Types::Moose qw/Str Int Bool Maybe ArrayRef/;
6     use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
7
8     # repository and sha1 are required initargs
9     has repository => ( isa => 'Gitalist::Git::Repository',
10                      required => 1,
11                      is => 'ro',
12                      weak_ref => 1,
13                      handles => {
14                          _run_cmd => 'run_cmd',
15                          _run_cmd_fh => 'run_cmd_fh',
16                          _run_cmd_list => 'run_cmd_list',
17                          _get_gpp_object => 'get_gpp_object',
18                      },
19                  );
20     has sha1 => ( isa => NonEmptySimpleStr,
21                   required => 1,
22                   is => 'ro' );
23
24     has type => ( isa => NonEmptySimpleStr,
25                   is => 'ro',
26                   required => 1 );
27
28     has $_ => ( isa => NonEmptySimpleStr,
29                 required => 1,
30                 is => 'ro',
31                 lazy_build => 1 )
32         for qw/modestr size/;
33
34     has _gpp_obj => ( isa => 'Git::PurePerl::Object',
35                       required => 1,
36                       is => 'ro',
37                       lazy_build => 1,
38                       handles => [ 'content',
39                                ],
40                   );
41
42     # objects can't determine their mode or filename
43     has file => ( isa => NonEmptySimpleStr,
44                   required => 0,
45                   is => 'ro' );
46     has mode => ( isa => Int,
47                   required => 1,
48                   default => 0,
49                   is => 'ro' );
50
51     method BUILD { $self->$_() for qw/_gpp_obj size modestr/ }
52
53 ## Private methods
54
55 ## Builders
56     method _build__gpp_obj {
57         return $self->_get_gpp_object($self->sha1)
58     }
59
60     method "_build_size" {
61         my $v = $self->_cat_file_with_flag('s');
62         chomp($v);
63         return $v;
64     }
65
66     method _cat_file_with_flag ($flag) {
67         $self->_run_cmd('cat-file', '-' . $flag, $self->{sha1})
68     }
69
70     method _build_modestr {
71         # XXX The POSIX constants make win32 sad :(
72         return eval { _mode_str($self->mode) } || '?rwxrwxrwx';
73     }
74
75     # via gitweb.pm circa line 1305
76     use Fcntl ':mode';
77     use constant {
78         S_IFINVALID => 0030000,
79         S_IFGITLINK => 0160000,
80     };
81
82     # submodule/subrepository, a commit object reference
83     sub S_ISGITLINK($) {
84         return (($_[0] & S_IFMT) == S_IFGITLINK)
85     }
86
87     # convert file mode in octal to symbolic file mode string
88     sub _mode_str {
89         my $mode = shift;
90
91         if (S_ISGITLINK($mode)) {
92             return 'm---------';
93         } elsif (S_ISDIR($mode & S_IFMT)) {
94             return 'drwxr-xr-x';
95         } elsif (S_ISLNK($mode)) {
96             return 'lrwxrwxrwx';
97         } elsif (S_ISREG($mode)) {
98             # git cares only about the executable bit
99             if ($mode & S_IXUSR) {
100                 return '-rwxr-xr-x';
101             } else {
102                 return '-rw-r--r--';
103             }
104         } else {
105             return '----------';
106         }
107     }
108
109 } # end class
110
111 __END__
112
113 =head1 NAME
114
115 Gitalist::Git::Object - Model of a git object.
116
117 =head1 SYNOPSIS
118
119     my $object = Repository->get_object($sha1);
120
121 =head1 DESCRIPTION
122
123 Abstract base class for git objects.
124
125
126 =head1 ATTRIBUTES
127
128
129 =head1 METHODS
130
131
132 =head1 AUTHORS
133
134 See L<Gitalist> for authors.
135
136 =head1 LICENSE
137
138 See L<Gitalist> for the license.
139
140 =cut