X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FGitalist%2FModel%2FGit.pm;h=1d9328f2200fe7d1f5bf156e795a10fe6e9f5fbf;hb=30e4d46d3ec8b7a731e84e3fe7ef375d33d78e61;hp=54d0fd728db21ee2644be47ade62ee381b3db82d;hpb=6cf4366a5211b91f2802c8cef78c97cd292f6004;p=catagits%2FGitalist.git diff --git a/lib/Gitalist/Model/Git.pm b/lib/Gitalist/Model/Git.pm index 54d0fd7..1d9328f 100644 --- a/lib/Gitalist/Model/Git.pm +++ b/lib/Gitalist/Model/Git.pm @@ -13,7 +13,7 @@ use Carp qw/croak/; use File::Find::Rule; use DateTime::Format::Mail; use File::Stat::ModeString; -use List::MoreUtils qw/any/; +use List::MoreUtils qw/any zip/; use Scalar::Util qw/blessed/; use MooseX::Types::Common::String qw/NonEmptySimpleStr/; # FIXME, use Types::Path::Class and coerce @@ -43,7 +43,11 @@ has gpp => ( isa => 'Git::PurePerl', is => 'rw', lazy_build => 1 ); sub build_per_context_instance { my ( $self, $c ) = @_; - + + # If we don't have a project param it probably means we're at / + return $self + unless $c->req->param('p'); + $self->project( $c->req->param('p') ); (my $pd = $self->project_dir( $self->project )) =~ s{/\.git$}(); @@ -140,7 +144,7 @@ sub project_dir { : $self->dir_from_project_name($project); $dir .= '/.git' - if -f dir($dir)->file('.git/HEAD'); + if -f dir($dir)->file('.git/HEAD'); return $dir; } @@ -177,10 +181,10 @@ sub command { Returns a hash corresponding to a given project's properties. The keys will be: - name - description (empty if .git/description is empty/unnamed) - owner - last_change + name + description (empty if .git/description is empty/unnamed) + owner + last_change =cut @@ -285,10 +289,10 @@ Find the hash of a given head (defaults to HEAD) of given (or current) project. =cut sub head_hash { - my ($self, $head, $project) = @_; + my ($self, $head) = @_; - my $output = $self->run_cmd_in($project || $self->project, qw/rev-parse --verify/, $head || 'HEAD' ); - return unless defined $output; + my($output) = $self->command(qw/rev-parse --verify/, $head || 'HEAD' ); + return unless $output; my($sha1) = $output =~ /^($SHA1RE)$/; return $sha1; @@ -299,21 +303,22 @@ sub head_hash { For a given tree sha1 return an array describing the tree's contents. Where the keys for each item will be: - mode - type - object - file + mode + type + object + file =cut sub list_tree { - my ($self, $rev, $project) = @_; + my ($self, $sha1) = @_; - $project ||= $self->project; - $rev ||= $self->head_hash($project); + $sha1 = $self->head_hash($sha1) + if !$sha1 or $sha1 !~ $SHA1RE; - my $output = $self->run_cmd_in($project, qw/ls-tree -z/, $rev); - return unless defined $output; + my($output) = $self->command(qw/ls-tree -z/, $sha1); + return + unless $output; my @ret; for my $line (split /\0/, $output) { @@ -321,7 +326,7 @@ sub list_tree { push @ret, { mode => oct $mode, - # XXX I wonder why directories always turn up as 040000 ... + # XXX I wonder why directories always turn up as 040000 ... modestr => $self->get_object_mode_string({mode=>oct $mode}), type => $type, object => $object, @@ -350,10 +355,10 @@ sub get_object_mode_string { =cut sub get_object_type { - my ($self, $object, $project) = @_; + my ($self, $object) = @_; - chomp(my $output = $self->run_cmd_in($project || $self->project, qw/cat-file -t/, $object)); - return unless $output; + my($output) = $self->command(qw/cat-file -t/, $object) + or return; return $output; } @@ -365,14 +370,14 @@ Return the contents of a given file. =cut sub cat_file { - my ($self, $object, $project) = @_; + my ($self, $object) = @_; my $type = $self->get_object_type($object); die "object `$object' is not a file\n" if (!defined $type || $type ne 'blob'); - my $output = $self->run_cmd_in($project || $self->project, qw/cat-file -p/, $object); - return unless $output; + my($output) = $self->command(qw/cat-file -p/, $object) + or return; return $output; } @@ -391,7 +396,7 @@ sub hash_by_path { my($line) = $self->command('ls-tree', $base, '--', $path) or return; - #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c' + #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c' $line =~ m/^([0-9]+) (.+) ($SHA1RE)\t/; return defined $type && $type ne $2 ? () @@ -417,13 +422,21 @@ Provides the raw output of a diff. =cut +# gitweb uses the following sort of command for diffing merges: +# /home/dbrook/apps/bin/git --git-dir=/home/dbrook/dev/app/.git diff-tree -r -M --no-commit-id --patch-with-raw --full-index --cc 316cf158df3f6207afbae7270bcc5ba0 -- +# and for regular diffs +# /home/dbrook/apps/bin/git --git-dir=/home/dbrook/dev/app/.git diff-tree -r -M --no-commit-id --patch-with-raw --full-index 2e3454ca0749641b42f063730b0090e1 316cf158df3f6207afbae7270bcc5ba0 -- + sub raw_diff { my ($self, @args) = @_; - return $self->command(diff => '--full-index', @args); + return $self->command( + qw(diff-tree -r -M --no-commit-id --full-index), + @args + ); } -=begin +=pod diff --git a/TODO b/TODO index 6a05e77..2071fd0 100644 --- a/TODO @@ -453,10 +466,37 @@ and some associated metadata. =cut +# XXX Ideally this would return a wee object instead of ad hoc structures. sub diff { - my($self, @revs) = @_; + my($self, %args) = @_; + + # So either a parent is specifed, or we use the commit's parent if there's + # only one, otherwise it was a merge commit. + my $parent = $args{parent} + ? $args{parent} + : @{$args{commit}->parents} <= 1 + ? $args{commit}->parent_sha1 + : '-c'; + my @etc = ( + ( $args{file} ? ('--', $args{file}) : () ), + ); + + my @out = $self->raw_diff( + ( $args{patch} ? '--patch-with-raw' : () ), + $parent, $args{commit}->sha1, @etc + ); + + # XXX Yes, there is much wrongness having parse_diff_tree be destructive. + my @difftree = $self->parse_diff_tree(\@out); + + return \@difftree + unless $args{patch}; + + # The blank line between the tree and the patch. + shift @out; - return $self->parse_diff($self->raw_diff(@revs)); + # XXX And no I'm not happy about having diff return tree + patch. + return \@difftree, [$self->parse_diff(@out)]; } sub parse_diff { @@ -464,25 +504,59 @@ sub parse_diff { my @ret; for (@diff) { - # This regex is a little pathological. - if(m{^diff --git (a/(.*?)) (b/\2)}) { + # This regex is a little pathological. + if(m{^diff --git (a/(.*?)) (b/\2)}) { push @ret, { - head => $_, - a => $1, - b => $3, - file => $2, - diff => '', + head => $_, + a => $1, + b => $3, + file => $2, + diff => '', }; - next; - } - - if(/^index (\w+)\.\.(\w+) (\d+)$/) { - @{$ret[-1]}{qw(index src dst mode)} = ($_, $1, $2, $3); - next + next; + } + + if(/^index (\w+)\.\.(\w+) (\d+)$/) { + @{$ret[-1]}{qw(index src dst mode)} = ($_, $1, $2, $3); + next } + + # XXX Somewhat hacky. Ahem. + $ret[@ret ? -1 : 0]{diff} .= "$_\n"; + } + + return @ret; +} + +# $ git diff-tree -r --no-commit-id -M b222ff0a7260cc1777c7e455dfcaf22551a512fc 7e54e579e196c6c545fee1030175f65a111039d4 +# :100644 100644 6a85d6c6315b55a99071974eb6ce643aeb2799d6 44c03ed6c328fa6de4b1d9b3f19a3de96b250370 M templates/blob.tt2 + +=head2 parse_diff_tree - # XXX Somewhat hacky. Ahem. - $ret[-1]{diff} .= "$_\n"; +Given a L commit object return a list of hashes corresponding +to the C output. + +=cut + +sub parse_diff_tree { + my($self, $diff) = @_; + + my @keys = qw(modesrc modedst sha1src sha1dst status src dst); + my @ret; + while(@$diff and $diff->[0] =~ /^:\d+/) { + my $line = shift @$diff; + # see. man git-diff-tree for more info + # mode src, mode dst, sha1 src, sha1 dst, status, src[, dst] + my @vals = $line =~ /^:(\d+) (\d+) ($SHA1RE) ($SHA1RE) ([ACDMRTUX]\d*)\t([^\t]+)(?:\t([^\n]+))?$/; + my %line = zip @keys, @vals; + # Some convenience keys + $line{file} = $line{src}; + $line{sha1} = $line{sha1dst}; + $line{is_new} = $line{sha1src} =~ /^0+$/ + if $line{sha1src}; + @line{qw/status sim/} = $line{status} =~ /(R)(\d+)/ + if $line{status} =~ /^R/; + push @ret, \%line; } return @ret; @@ -496,22 +570,11 @@ Given the output of the C command return a list of hashes. 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, $self->get_object($line); - } - } - } - - return @ret; + return + map $self->get_object($_), + grep $self->valid_rev($_), + map split(/\n/, $_, 6), split /\0/, $output; } =head2 list_revs @@ -524,12 +587,28 @@ array of hashes. sub list_revs { my ($self, %args) = @_; - $args{sha1} ||= $self->head_hash($args{project}); + $args{sha1} = $self->head_hash($args{sha1}) + if !$args{sha1} || $args{sha1} !~ $SHA1RE; + + my @search_opts; + if($args{search}) { + my $sargs = $args{search}; + $sargs->{type} = 'grep' + if $sargs->{type} eq 'commit'; + @search_opts = ( + # This seems a little fragile ... + qq[--$sargs->{type}=$sargs->{text}], + '--regexp-ignore-case', + $sargs->{regexp} ? '--extended-regexp' : '--fixed-strings' + ); + } + $DB::single=1; my $output = $self->run_cmd_in($args{project} || $self->project, 'rev-list', '--header', - (defined $args{ count } ? "--max-count=$args{count}" : ()), - (defined $args{ skip } ? "--skip=$args{skip}" : ()), + (defined $args{ count } ? "--max-count=$args{count}" : ()), + (defined $args{ skip } ? "--skip=$args{skip}" : ()), + @search_opts, $args{sha1}, '--', ($args{file} ? $args{file} : ()), @@ -553,8 +632,8 @@ sub rev_info { return unless $self->valid_rev($rev); return $self->list_revs( - rev => $rev, count => 1, - ( $project ? (project => $project) : () ) + rev => $rev, count => 1, + ( $project ? (project => $project) : () ) ); } @@ -571,8 +650,7 @@ sub reflog { = $self->run_cmd_in($self->project, qw(log -g), @logargs) =~ /(^commit.+?(?:(?=^commit)|(?=\z)))/msg; -=begin - +=pod commit 02526fc15beddf2c64798a947fecdd8d11bf993d Reflog: HEAD@{14} (The Git Server ) Reflog message: push @@ -649,11 +727,11 @@ For a given sha1 check which branches currently point at it. =cut sub refs_for { - my($self, $sha1) = @_; + my($self, $sha1) = @_; - my $refs = $self->references->{$sha1}; + my $refs = $self->references->{$sha1}; - return $refs ? @$refs : (); + return $refs ? @$refs : (); } =head2 references @@ -664,68 +742,23 @@ C. =cut sub references { - my($self) = @_; - - return $self->{references} - if $self->{references}; - - # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11 - # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{} - my @reflist = $self->command(qw(show-ref --dereference)) - or return; - - my %refs; - for(@reflist) { - push @{$refs{$1}}, $2 - if m!^($SHA1RE)\srefs/(.*)$!; - } - - return $self->{references} = \%refs; -} - -=begin + my($self) = @_; -$ git diff-tree -r --no-commit-id -M b222ff0a7260cc1777c7e455dfcaf22551a512fc 7e54e579e196c6c545fee1030175f65a111039d4 -:100644 100644 8976ebc7df65475b3def53a1653533c3f61070d0 852b6e170f1bad1fbd9930d3178dda8fdf1feae7 M TODO -:100644 100644 75f5e5f9ed10ae82a960fde77ecf138159c37610 7f54f8c3a4ad426f6889b13cfba5f5ad9969e3c6 M lib/Gitalist/Controller/Root.pm -:100644 100644 2c65caa46b56302502b9e6eef952b6f379c71fee e418acf5f7b5f771b0b2ef8be784e8dcd60a4271 M lib/Gitalist/View/Default.pm -:000000 100644 0000000000000000000000000000000000000000 642599f9ccfc4dbc7034987ad3233655010ff348 A lib/Gitalist/View/SyntaxHighlight.pm -:000000 100644 0000000000000000000000000000000000000000 3d2e533c41f01276b6f844bae98297273b38dffc A root/static/css/syntax-dark.css -:100644 100644 6a85d6c6315b55a99071974eb6ce643aeb2799d6 44c03ed6c328fa6de4b1d9b3f19a3de96b250370 M templates/blob.tt2 + return $self->{references} + if $self->{references}; -=cut - -use List::MoreUtils qw(zip); -# XXX Hrm, getting called twice, not sure why. -=head2 diff_tree + # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11 + # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{} + my @reflist = $self->command(qw(show-ref --dereference)) + or return; -Given a L commit object return a list of hashes corresponding -to the C output. - -=cut + my %refs; + for(@reflist) { + push @{$refs{$1}}, $2 + if m!^($SHA1RE)\srefs/(.*)$!; + } -sub diff_tree { - my($self, $commit) = @_; - - my @dtout = $self->command( - # XXX should really deal with multple parents ... - qw(diff-tree -r --no-commit-id -M), $commit->parent_sha1, $commit->sha1 - ); - - my @keys = qw(modesrc modedst sha1src sha1dst status src dst); - my @difftree = map { - # see. man git-diff-tree for more info - # mode src, mode dst, sha1 src, sha1 dst, status, src[, dst] - my @vals = /^:(\d+) (\d+) ($SHA1RE) ($SHA1RE) ([ACDMRTUX])\t([^\t]+)(?:\t([^\n]+))?$/; - my %line = zip @keys, @vals; - # Some convenience keys - $line{file} = $line{src}; - $line{sha1} = $line{sha1dst}; - $line{is_new} = $line{sha1src} =~ /^0+$/; - \%line; - } @dtout; - - return @difftree; + return $self->{references} = \%refs; } 1;