From: broquaint Date: Wed, 7 Oct 2009 16:33:00 +0000 (+0100) Subject: Brought back recent Moosey goodness so all should be working again. X-Git-Tag: 0.000000_01~108^2~25 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1feb3d6b09a8499205be3e71b928c9828ab3fbf1;p=catagits%2FGitalist.git Brought back recent Moosey goodness so all should be working again. --- diff --git a/lib/Gitalist/Controller/Root.pm b/lib/Gitalist/Controller/Root.pm index 7aa9b94..75f5e5f 100644 --- a/lib/Gitalist/Controller/Root.pm +++ b/lib/Gitalist/Controller/Root.pm @@ -93,7 +93,7 @@ sub reflog : Local { ); } -sub commit { +sub commit : Local { my ( $self, $c ) = @_; $c->stash( @@ -105,12 +105,6 @@ sub commit { sub auto : Private { my($self, $c) = @_; - # XXX Probably not the best place for it but it will do for now. - if(my $proj = $c->req->param('p')) { - my $m = $c->model('Git'); - $m->project($proj); - } - # Yes, this is hideous. $self->header($c); $self->footer($c); diff --git a/lib/Gitalist/Model/Git.pm b/lib/Gitalist/Model/Git.pm index 77f324a..c6adc8d 100644 --- a/lib/Gitalist/Model/Git.pm +++ b/lib/Gitalist/Model/Git.pm @@ -1,346 +1,417 @@ package Gitalist::Model::Git; use Moose; -use MooseX::Types::Common::String qw/NonEmptySimpleStr/; # FIXME, use Types::Path::Class and coerce use namespace::autoclean; BEGIN { extends 'Catalyst::Model' } use DateTime; use Path::Class; +use File::Which; use Carp qw/croak/; use File::Find::Rule; use DateTime::Format::Mail; use File::Stat::ModeString; use List::MoreUtils qw/any/; -use File::Which; +use Scalar::Util qw/blessed/; +use MooseX::Types::Common::String qw/NonEmptySimpleStr/; # FIXME, use Types::Path::Class and coerce +has project => ( isa => NonEmptySimpleStr, is => 'rw'); has repo_dir => ( isa => NonEmptySimpleStr, is => 'ro', lazy_build => 1 ); # Fixme - path::class has git => ( isa => NonEmptySimpleStr, is => 'ro', lazy_build => 1 ); - + sub BUILD { my ($self) = @_; $self->git; # Cause lazy value build. - $self->repo_dir; + $self->repo_dir; } sub _build_git { - my $git = File::Which::which('git'); + my $git = File::Which::which('git'); - if (!$git) { - die <config->{repo_dir}; + return Gitalist->config->{repo_dir}; } sub is_git_repo { - my ($self, $dir) = @_; + my ($self, $dir) = @_; - return -f $dir->file('HEAD') || -f $dir->file('.git/HEAD'); + return -f $dir->file('HEAD') || -f $dir->file('.git/HEAD'); } sub project_info { - my ($self, $project) = @_; + my ($self, $project) = @_; - return { - name => $project, - $self->get_project_properties( - $self->git_dir_from_project_name($project), - ), + return { + name => $project, + $self->get_project_properties( + $self->git_dir_from_project_name($project), + ), }; } sub get_project_properties { - my ($self, $dir) = @_; - my %props; + my ($self, $dir) = @_; + my %props; - eval { - $props{description} = $dir->file('description')->slurp; - chomp $props{description}; + eval { + $props{description} = $dir->file('description')->slurp; + chomp $props{description}; }; - if ($props{description} && $props{description} =~ /^Unnamed repository;/) { - delete $props{description}; - } + if ($props{description} && $props{description} =~ /^Unnamed repository;/) { + delete $props{description}; + } - $props{owner} = (getpwuid $dir->stat->uid)[6]; + ($props{owner} = (getpwuid $dir->stat->uid)[6]) =~ s/,+$//; - my $output = $self->run_cmd_in($dir, qw{ - for-each-ref --format=%(committer) - --sort=-committerdate --count=1 refs/heads - }); + my $output = $self->run_cmd_in($dir, qw{ + for-each-ref --format=%(committer) + --sort=-committerdate --count=1 refs/heads + }); - if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) { - my $dt = DateTime->from_epoch(epoch => $epoch); - $dt->set_time_zone($tz); - $props{last_change} = $dt; - } + if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) { + my $dt = DateTime->from_epoch(epoch => $epoch); + $dt->set_time_zone($tz); + $props{last_change} = $dt; + } - return %props; + return %props; } sub list_projects { - my ($self) = @_; + my ($self) = @_; - my $base = dir($self->repo_dir); + my $base = dir($self->repo_dir); - my @ret; - my $dh = $base->open; - while (my $file = $dh->read) { - next if $file =~ /^.{1,2}$/; - - my $obj = $base->subdir($file); - next unless -d $obj; - next unless $self->is_git_repo($obj); - # XXX Leaky abstraction alert! - my $is_bare = !-d $obj->subdir('.git'); - - my $name = (File::Spec->splitdir($obj))[-1]; - push @ret, { - name => ($name . ( $is_bare ? '' : '/.git' )), - $self->get_project_properties( - $is_bare ? $obj : $obj->subdir('.git') - ), - }; - } + my @ret; + my $dh = $base->open; + while (my $file = $dh->read) { + next if $file =~ /^.{1,2}$/; + + my $obj = $base->subdir($file); + next unless -d $obj; + next unless $self->is_git_repo($obj); + + # XXX Leaky abstraction alert! + my $is_bare = !-d $obj->subdir('.git'); - return [sort { $a->{name} cmp $b->{name} } @ret]; + my $name = (File::Spec->splitdir($obj))[-1]; + push @ret, { + name => ($name . ( $is_bare ? '.git' : '/.git' )), + $self->get_project_properties( + $is_bare ? $obj : $obj->subdir('.git') + ), + }; + } + + return [sort { $a->{name} cmp $b->{name} } @ret]; } sub run_cmd { - my ($self, @args) = @_; + my ($self, @args) = @_; + + open my $fh, '-|', $self->git, @args + or die "failed to run git command"; + binmode $fh, ':encoding(UTF-8)'; + + my $output = do { local $/ = undef; <$fh> }; + close $fh; - open my $fh, '-|', $self->git, @args - or die "failed to run git command"; - binmode $fh, ':encoding(UTF-8)'; + return $output; +} + +sub project_dir { + my($self, $project) = @_; - my $output = do { local $/ = undef; <$fh> }; - close $fh; + my $dir = blessed($project) && $project->isa('Path::Class::Dir') + ? $project->stringify + : $self->git_dir_from_project_name($project); - return $output; + $dir =~ s/\.git$//; + + return $dir; } sub run_cmd_in { - my ($self, $project, @args) = @_; + my ($self, $project, @args) = @_; - my $path; - if (blessed($project) && $project->isa('Path::Class::Dir')) { - $path = $project->stringify; - } - else { - $path = $self->git_dir_from_project_name($project); - } - return $self->run_cmd('--git-dir' => $path, @args); + return $self->run_cmd('--git-dir' => $self->project_dir($project), @args); } sub git_dir_from_project_name { - my ($self, $project) = @_; + my ($self, $project) = @_; - return dir($self->repo_dir)->subdir($project); + return dir($self->repo_dir)->subdir($project); } sub get_head_hash { - my ($self, $project) = @_; + my ($self, $project) = @_; - my $output = $self->run_cmd_in($project, qw/rev-parse --verify HEAD/ ); - return unless defined $output; + my $output = $self->run_cmd_in($self->project, qw/rev-parse --verify HEAD/ ); + return unless defined $output; - my ($head) = $output =~ /^([0-9a-fA-F]{40})$/; - return $head; + my ($head) = $output =~ /^([0-9a-fA-F]{40})$/; + return $head; } sub list_tree { - my ($self, $project, $rev) = @_; + my ($self, $project, $rev) = @_; - $rev ||= $self->get_head_hash($project); + $rev ||= $self->get_head_hash($project); - my $output = $self->run_cmd_in($project, qw/ls-tree -z/, $rev); - return unless defined $output; + my $output = $self->run_cmd_in($project, qw/ls-tree -z/, $rev); + return unless defined $output; - my @ret; - for my $line (split /\0/, $output) { - my ($mode, $type, $object, $file) = split /\s+/, $line, 4; - - push @ret, { - mode => oct $mode, - type => $type, - object => $object, - file => $file, - }; - } + my @ret; + for my $line (split /\0/, $output) { + my ($mode, $type, $object, $file) = split /\s+/, $line, 4; - return @ret; + push @ret, { + mode => oct $mode, + type => $type, + object => $object, + file => $file, + }; + } + + return @ret; } sub get_object_mode_string { - my ($self, $object) = @_; + my ($self, $object) = @_; - return unless $object && $object->{mode}; - return mode_to_string($object->{mode}); + return unless $object && $object->{mode}; + return mode_to_string($object->{mode}); } sub get_object_type { - my ($self, $project, $object) = @_; + my ($self, $project, $object) = @_; + + my $output = $self->run_cmd_in($project, qw/cat-file -t/, $object); + return unless $output; + + chomp $output; + return $output; +} + +sub get_hash_by_path { + my($self, $base, $path, $type) = @_; - my $output = $self->run_cmd_in($project, qw/cat-file -t/, $object); - return unless $output; + $path =~ s{/+$}(); - chomp $output; - return $output; + my $line = $self->run_cmd_in($self->project, 'ls-tree', $base, '--', $path) + or return; + + #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c' + $line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/; + return defined $type && $type ne $2 + ? () + : return $3; } sub cat_file { - my ($self, $project, $object) = @_; + my ($self, $object) = @_; - my $type = $self->get_object_type($project, $object); - die "object `$object' is not a file\n" - if (!defined $type || $type ne 'blob'); + my $type = $self->get_object_type($self->project, $object); + die "object `$object' is not a file\n" + if (!defined $type || $type ne 'blob'); - my $output = $self->run_cmd_in($project, qw/cat-file -p/, $object); - return unless $output; + my $output = $self->run_cmd_in($self->project, qw/cat-file -p/, $object); + return unless $output; - return $output; + return $output; } sub valid_rev { - my ($self, $rev) = @_; + my ($self, $rev) = @_; - return unless $rev; - return ($rev =~ /^([0-9a-fA-F]{40})$/); + return unless $rev; + return ($rev =~ /^([0-9a-fA-F]{40})$/); } sub diff { - my ($self, $project, @revs) = @_; + my ($self, $project, @revs) = @_; - croak("Gitalist::Model::Git::diff needs a project and either one or two revisions") - if scalar @revs < 1 - || scalar @revs > 2 - || any { !$self->valid_rev($_) } @revs; + croak("Gitalist::Model::Git::diff needs a project and either one or two revisions") + if scalar @revs < 1 + || scalar @revs > 2 + || any { !$self->valid_rev($_) } @revs; - my $output = $self->run_cmd_in($project, 'diff', @revs); - return unless $output; + my $output = $self->run_cmd_in($project, 'diff', @revs); + return unless $output; - return $output; + return $output; } { - my $formatter = DateTime::Format::Mail->new; - - sub parse_rev_list { - my ($self, $output) = @_; - my @ret; - - my @revs = split /\0/, $output; - - for my $rev (split /\0/, $output) { - for my $line (split /\n/, $rev, 6) { - chomp $line; - next unless $line; - - if ($self->valid_rev($line)) { - push @ret, {rev => $line}; - next; - } - - if (my ($key, $value) = $line =~ /^(tree|parent)\s+(.*)$/) { - $ret[-1]->{$key} = $value; - next; - } - - if (my ($key, $value, $epoch, $tz) = $line =~ /^(author|committer)\s+(.*)\s+(\d+)\s+([+-]\d+)$/) { - $ret[-1]->{$key} = $value; - eval { - $ret[-1]->{ $key . "_datetime" } = DateTime->from_epoch(epoch => $epoch); - $ret[-1]->{ $key . "_datetime" }->set_time_zone($tz); - $ret[-1]->{ $key . "_datetime" }->set_formatter($formatter); - }; - - if ($@) { - $ret[-1]->{ $key . "_datetime" } = "$epoch $tz"; - } - - if (my ($name, $email) = $value =~ /^([^<]+)\s+<([^>]+)>$/) { - $ret[-1]->{ $key . "_name" } = $name; - $ret[-1]->{ $key . "_email" } = $email; - } - } - - $line =~ s/^\n?\s{4}//; - $ret[-1]->{longmessage} = $line; - $ret[-1]->{message} = (split /\n/, $line, 2)[0]; - } + my $formatter = DateTime::Format::Mail->new; + + sub parse_rev_list { + my ($self, $output) = @_; + my @ret; + + my @revs = split /\0/, $output; + + for my $rev (split /\0/, $output) { + for my $line (split /\n/, $rev, 6) { + chomp $line; + next unless $line; + + if ($self->valid_rev($line)) { + push @ret, {rev => $line}; + next; } - return @ret; + if (my ($key, $value) = $line =~ /^(tree|parent)\s+(.*)$/) { + $ret[-1]->{$key} = $value; + next; + } + + if (my ($key, $value, $epoch, $tz) = $line =~ /^(author|committer)\s+(.*)\s+(\d+)\s+([+-]\d+)$/) { + $ret[-1]->{$key} = $value; + eval { + $ret[-1]->{ $key . "_datetime" } = DateTime->from_epoch(epoch => $epoch); + $ret[-1]->{ $key . "_datetime" }->set_time_zone($tz); + $ret[-1]->{ $key . "_datetime" }->set_formatter($formatter); + }; + + if ($@) { + $ret[-1]->{ $key . "_datetime" } = "$epoch $tz"; + } + + if (my ($name, $email) = $value =~ /^([^<]+)\s+<([^>]+)>$/) { + $ret[-1]->{ $key . "_name" } = $name; + $ret[-1]->{ $key . "_email" } = $email; + } + } + + $line =~ s/^\n?\s{4}//; + $ret[-1]->{longmessage} = $line; + $ret[-1]->{message} = (split /\n/, $line, 2)[0]; + } } + + return @ret; + } } sub list_revs { - my ($self, $project, %args) = @_; + my ($self, $project, %args) = @_; - $args{rev} ||= $self->get_head_hash($project); + $args{rev} ||= $self->get_head_hash($project); - my $output = $self->run_cmd_in($project, 'rev-list', - '--header', - (defined $args{ count } ? "--max-count=$args{count}" : ()), - (defined $args{ skip } ? "--skip=$args{skip}" : ()), - $args{rev}, - '--', - ($args{file} || ()), + my $output = $self->run_cmd_in($project, 'rev-list', + '--header', + (defined $args{ count } ? "--max-count=$args{count}" : ()), + (defined $args{ skip } ? "--skip=$args{skip}" : ()), + $args{rev}, + '--', + ($args{file} || ()), ); - return unless $output; + return unless $output; - my @revs = $self->parse_rev_list($output); + my @revs = $self->parse_rev_list($output); - return \@revs; + return \@revs; } sub rev_info { - my ($self, $project, $rev) = @_; + my ($self, $project, $rev) = @_; - return unless $self->valid_rev($rev); + return unless $self->valid_rev($rev); - return $self->list_revs($project, rev => $rev, count => 1); + return $self->list_revs($project, rev => $rev, count => 1); +} + +sub reflog { + my ($self, @logargs) = @_; + + my @entries + = $self->run_cmd_in($self->project, qw(log -g), @logargs) + =~ /(^commit.+?(?:(?=^commit)|(?=\z)))/msg; + +=begin + + commit 02526fc15beddf2c64798a947fecdd8d11bf993d + Reflog: HEAD@{14} (The Git Server ) + Reflog message: push + Author: Iain Loasby + Date: Thu Sep 17 12:26:05 2009 +0100 + + Merge branch 'rt125181 +=cut + + return map { + + # XXX Stuff like this makes me want to switch to Git::PurePerl + my($sha1, $type, $author, $date) + = m{ + ^ commit \s+ ([0-9a-f]+)$ + .*? + Reflog[ ]message: \s+ (.+?)$ \s+ + Author: \s+ ([^<]+) <.*?$ \s+ + Date: \s+ (.+?)$ +}xms; + + pos($_) = index($_, $date) + length $date; + + # Yeah, I just did that. + + my($msg) = /\G\s+(\S.*)/sg; + + { + hash => $sha1, + type => $type, + author => $author, + + # XXX Add DateTime goodness. + date => $date, + message => $msg, + }; + } @entries; } sub get_heads { - my ($self, $project) = @_; + my ($self, $project) = @_; - my $output = $self->run_cmd_in($project, qw/for-each-ref --sort=-committerdate /, '--format=%(objectname)%00%(refname)%00%(committer)', 'refs/heads'); - return unless $output; + my $output = $self->run_cmd_in($project, qw/for-each-ref --sort=-committerdate /, '--format=%(objectname)%00%(refname)%00%(committer)', 'refs/heads'); + return unless $output; - my @ret; - for my $line (split /\n/, $output) { - my ($rev, $head, $commiter) = split /\0/, $line, 3; - $head =~ s!^refs/heads/!!; + my @ret; + for my $line (split /\n/, $output) { + my ($rev, $head, $commiter) = split /\0/, $line, 3; + $head =~ s!^refs/heads/!!; - push @ret, { rev => $rev, name => $head }; + push @ret, { rev => $rev, name => $head }; - #FIXME: That isn't the time I'm looking for.. - if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) { - my $dt = DateTime->from_epoch(epoch => $epoch); - $dt->set_time_zone($tz); - $ret[-1]->{last_change} = $dt; - } + #FIXME: That isn't the time I'm looking for.. + if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) { + my $dt = DateTime->from_epoch(epoch => $epoch); + $dt->set_time_zone($tz); + $ret[-1]->{last_change} = $dt; } + } - return \@ret; + return \@ret; } sub archive { - my ($self, $project, $rev) = @_; + my ($self, $project, $rev) = @_; - #FIXME: huge memory consuption - #TODO: compression - return $self->run_cmd_in($project, qw/archive --format=tar/, "--prefix=${project}/", $rev); + #FIXME: huge memory consuption + #TODO: compression + return $self->run_cmd_in($project, qw/archive --format=tar/, "--prefix=${project}/", $rev); } 1; diff --git a/lib/Gitalist/View/Default.pm b/lib/Gitalist/View/Default.pm index 986ff75..2c65caa 100644 --- a/lib/Gitalist/View/Default.pm +++ b/lib/Gitalist/View/Default.pm @@ -18,7 +18,7 @@ Catalyst View. =head1 AUTHOR -Dan Brook,,, +Dan Brook =head1 LICENSE