[catagits/Gitalist.git] / lib / Gitalist / Model / Git.pm

package Gitalist::Model::Git;

use Moose;
use namespace::autoclean;

BEGIN { extends 'Catalyst::Model' }

use DateTime;
use Path::Class;
use Carp qw/croak/;
use File::Find::Rule;
use DateTime::Format::Mail;
use File::Stat::ModeString;
use List::MoreUtils qw/any/;
use Scalar::Util qw/blessed/;

{
	my $git;
	sub git {
		return $git
			if $git;

		if (my $config_git = Gitalist->config->{git}) {
			$git = $config_git if -x $config_git;
		}
		else {
			require File::Which;
			$git = File::Which::which('git');
		}

		if (!$git) {
			die <<EOR
Could not find a git executable.
Please specify the which git executable to use in gitweb.yml
EOR
		}

		return $git;
	}
}

sub is_git_repo {
    my ($self, $dir) = @_;

    return -f $dir->file('HEAD') || -f $dir->file('.git/HEAD');
}

sub project_info {
    my ($self, $project) = @_;

    return {
        name => $project,
        $self->get_project_properties(
                $self->git_dir_from_project_name($project),
        ),
    };
}

sub get_project_properties {
    my ($self, $dir) = @_;
    my %props;

    eval {
        $props{description} = $dir->file('description')->slurp;
        chomp $props{description};
    };

    if ($props{description} && $props{description} =~ /^Unnamed repository;/) {
        delete $props{description};
    }

    $props{owner} = (getpwuid $dir->stat->uid)[6];

    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;
    }

    return %props;
}

sub list_projects {
    my ($self) = @_;

    my $base = dir(Gitalist->config->{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' : '/.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) = @_;

    open my $fh, '-|', __PACKAGE__->git, @args
        or die "failed to run git command";
    binmode $fh, ':encoding(UTF-8)';

    print STDERR "RAN - git @_[1..$#_]\n"; 

    my $output = do { local $/ = undef; <$fh> };
    close $fh;

    return $output;
}

sub run_cmd_in {
    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);
}

sub git_dir_from_project_name {
    my ($self, $project) = @_;

    return dir(Gitalist->config->{repo_dir})->subdir($project);
}

sub get_head_hash {
    my ($self, $project) = @_;

    my $output = $self->run_cmd_in($project, qw/rev-parse --verify HEAD/ );
    return unless defined $output;

    my ($head) = $output =~ /^([0-9a-fA-F]{40})$/;
    return $head;
}

sub list_tree {
    my ($self, $project, $rev) = @_;

    $rev ||= $self->get_head_hash($project);

    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,
        };
    }

    return @ret;
}

sub get_object_mode_string {
    my ($self, $object) = @_;

    return unless $object && $object->{mode};
    return mode_to_string($object->{mode});
}

sub get_object_type {
    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, $project, $base, $path, $type) = @_;

	$path =~ s{/+$}();

	my $line = $self->run_cmd_in($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 $type = $self->get_object_type($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;

    return $output;
}

sub valid_rev {
    my ($self, $rev) = @_;

    return unless $rev;
    return ($rev =~ /^([0-9a-fA-F]{40})$/);
}

sub diff {
    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;

    my $output = $self->run_cmd_in($project, 'diff', @revs);
    return unless $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];
            }
        }

        return @ret;
    }
}

sub list_revs {
    my ($self, $project, %args) = @_;

    $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} || ()),
    );
    return unless $output;

    my @revs = $self->parse_rev_list($output);

    return \@revs;
}

sub rev_info {
    my ($self, $project, $rev) = @_;

    return unless $self->valid_rev($rev);

    return $self->list_revs($project, rev => $rev, count => 1);
}

sub reflog {
    my ($self, $project, @logargs) = @_;

    my @entries
      =  $self->run_cmd_in($project, qw(log -g), @logargs)
      =~ /(^commit.+?(?:(?=^commit)|(?=\z)))/msg;

=begin

  commit 02526fc15beddf2c64798a947fecdd8d11bf993d
  Reflog: HEAD@{14} (The Git Server <git@git.dev.venda.com>)
  Reflog message: push
  Author: Iain Loasby <iloasby@rowlf.of-2.uk.venda.com>
  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 $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/!!;

        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;
        }
    }

    return \@ret;
}

sub archive {
    my ($self, $project, $rev) = @_;

    #FIXME: huge memory consuption
    #TODO: compression
    return $self->run_cmd_in($project, qw/archive --format=tar/, "--prefix=${project}/", $rev);
}

1;

__PACKAGE__->meta->make_immutable;
Commit	Line	Data
fbf3eb7e	1	package Gitalist::Model::Git;
	2
	3	use Moose;
	4	use namespace::autoclean;
	5
86382b95	6	BEGIN { extends 'Catalyst::Model' }
86382b95	7
fbf3eb7e	8	use DateTime;
	9	use Path::Class;
	10	use Carp qw/croak/;
	11	use File::Find::Rule;
	12	use DateTime::Format::Mail;
	13	use File::Stat::ModeString;
	14	use List::MoreUtils qw/any/;
	15	use Scalar::Util qw/blessed/;
	16
04d1d917	17	{
	18	my $git;
	19	sub git {
	20	return $git
	21	if $git;
fbf3eb7e	22
	23	if (my $config_git = Gitalist->config->{git}) {
	24	$git = $config_git if -x $config_git;
	25	}
	26	else {
	27	require File::Which;
	28	$git = File::Which::which('git');
	29	}
	30
	31	if (!$git) {
	32	die <<EOR
	33	Could not find a git executable.
	34	Please specify the which git executable to use in gitweb.yml
	35	EOR
	36	}
	37
	38	return $git;
04d1d917	39	}
04d1d917	40	}
fbf3eb7e	41
	42	sub is_git_repo {
	43	my ($self, $dir) = @_;
	44
d5cc37a4	45	return -f $dir->file('HEAD') \|\| -f $dir->file('.git/HEAD');
fbf3eb7e	46	}
	47
	48	sub project_info {
	49	my ($self, $project) = @_;
	50
	51	return {
	52	name => $project,
	53	$self->get_project_properties(
	54	$self->git_dir_from_project_name($project),
	55	),
	56	};
	57	}
	58
	59	sub get_project_properties {
	60	my ($self, $dir) = @_;
	61	my %props;
	62
	63	eval {
	64	$props{description} = $dir->file('description')->slurp;
	65	chomp $props{description};
	66	};
	67
04d1d917	68	if ($props{description} && $props{description} =~ /^Unnamed repository;/) {
fbf3eb7e	69	delete $props{description};
	70	}
	71
	72	$props{owner} = (getpwuid $dir->stat->uid)[6];
	73
	74	my $output = $self->run_cmd_in($dir, qw{
	75	for-each-ref --format=%(committer)
	76	--sort=-committerdate --count=1 refs/heads
	77	});
	78
	79	if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
	80	my $dt = DateTime->from_epoch(epoch => $epoch);
	81	$dt->set_time_zone($tz);
	82	$props{last_change} = $dt;
	83	}
	84
	85	return %props;
	86	}
	87
	88	sub list_projects {
	89	my ($self) = @_;
	90
	91	my $base = dir(Gitalist->config->{repo_dir});
	92
	93	my @ret;
	94	my $dh = $base->open;
	95	while (my $file = $dh->read) {
	96	next if $file =~ /^.{1,2}$/;
	97
	98	my $obj = $base->subdir($file);
	99	next unless -d $obj;
	100	next unless $self->is_git_repo($obj);
d5cc37a4	101	# XXX Leaky abstraction alert!
e66db0fb	102	my $is_bare = !-d $obj->subdir('.git');
fbf3eb7e	103
e66db0fb	104	my $name = (File::Spec->splitdir($obj))[-1];
fbf3eb7e	105	push @ret, {
e66db0fb	106	name => ($name . ( $is_bare ? '.git' : '/.git' )),
	107	$self->get_project_properties(
	108	$is_bare ? $obj : $obj->subdir('.git')
	109	),
fbf3eb7e	110	};
	111	}
	112
e99c6ee1	113	return [sort { $a->{name} cmp $b->{name} } @ret];
fbf3eb7e	114	}
	115
	116	sub run_cmd {
	117	my ($self, @args) = @_;
	118
	119	open my $fh, '-\|', __PACKAGE__->git, @args
	120	or die "failed to run git command";
	121	binmode $fh, ':encoding(UTF-8)';
	122
c5065c66	123	print STDERR "RAN - git @_[1..$#_]\n";
c5065c66	124
fbf3eb7e	125	my $output = do { local $/ = undef; <$fh> };
	126	close $fh;
	127
	128	return $output;
	129	}
	130
	131	sub run_cmd_in {
	132	my ($self, $project, @args) = @_;
	133
	134	my $path;
	135	if (blessed($project) && $project->isa('Path::Class::Dir')) {
	136	$path = $project->stringify;
	137	}
	138	else {
	139	$path = $self->git_dir_from_project_name($project);
	140	}
	141	return $self->run_cmd('--git-dir' => $path, @args);
	142	}
	143
	144	sub git_dir_from_project_name {
	145	my ($self, $project) = @_;
	146
	147	return dir(Gitalist->config->{repo_dir})->subdir($project);
	148	}
	149
	150	sub get_head_hash {
	151	my ($self, $project) = @_;
	152
	153	my $output = $self->run_cmd_in($project, qw/rev-parse --verify HEAD/ );
	154	return unless defined $output;
	155
	156	my ($head) = $output =~ /^([0-9a-fA-F]{40})$/;
	157	return $head;
	158	}
	159
	160	sub list_tree {
	161	my ($self, $project, $rev) = @_;
	162
	163	$rev \|\|= $self->get_head_hash($project);
	164
	165	my $output = $self->run_cmd_in($project, qw/ls-tree -z/, $rev);
	166	return unless defined $output;
	167
	168	my @ret;
	169	for my $line (split /\0/, $output) {
	170	my ($mode, $type, $object, $file) = split /\s+/, $line, 4;
	171
	172	push @ret, {
	173	mode => oct $mode,
	174	type => $type,
	175	object => $object,
	176	file => $file,
	177	};
	178	}
	179
	180	return @ret;
	181	}
	182
	183	sub get_object_mode_string {
	184	my ($self, $object) = @_;
	185
	186	return unless $object && $object->{mode};
	187	return mode_to_string($object->{mode});
	188	}
189
190	sub get_object_type {
191	my ($self, $project, $object) = @_;
192
193	my $output = $self->run_cmd_in($project, qw/cat-file -t/, $object);
194	return unless $output;
195
196	chomp $output;
197	return $output;
198	}
199
295c9703	200	sub get_hash_by_path {
c5065c66	201	my($self, $project, $base, $path, $type) = @_;
295c9703	202
	203	$path =~ s{/+$}();
	204
c5065c66	205	my $line = $self->run_cmd_in($project, 'ls-tree', $base, '--', $path)
295c9703	206	or return;
	207
	208	#'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
	209	$line =~ m/^([0-9]+) (.+) ([0-9a-fA-F]{40})\t/;
	210	return defined $type && $type ne $2
	211	? ()
	212	: return $3;
	213	}
	214
fbf3eb7e	215	sub cat_file {
	216	my ($self, $project, $object) = @_;
	217
	218	my $type = $self->get_object_type($project, $object);
	219	die "object `$object' is not a file\n"
	220	if (!defined $type \|\| $type ne 'blob');
	221
	222	my $output = $self->run_cmd_in($project, qw/cat-file -p/, $object);
	223	return unless $output;
	224
	225	return $output;
	226	}
	227
	228	sub valid_rev {
	229	my ($self, $rev) = @_;
	230
	231	return unless $rev;
	232	return ($rev =~ /^([0-9a-fA-F]{40})$/);
	233	}
	234
	235	sub diff {
	236	my ($self, $project, @revs) = @_;
	237
	238	croak("Gitalist::Model::Git::diff needs a project and either one or two revisions")
	239	if scalar @revs < 1
	240	\|\| scalar @revs > 2
	241	\|\| any { !$self->valid_rev($_) } @revs;
	242
	243	my $output = $self->run_cmd_in($project, 'diff', @revs);
	244	return unless $output;
	245
	246	return $output;
	247	}
	248
	249	{
	250	my $formatter = DateTime::Format::Mail->new;
	251
	252	sub parse_rev_list {
	253	my ($self, $output) = @_;
	254	my @ret;
	255
	256	my @revs = split /\0/, $output;
	257
	258	for my $rev (split /\0/, $output) {
	259	for my $line (split /\n/, $rev, 6) {
	260	chomp $line;
	261	next unless $line;
	262
	263	if ($self->valid_rev($line)) {
	264	push @ret, {rev => $line};
	265	next;
	266	}
	267
	268	if (my ($key, $value) = $line =~ /^(tree\|parent)\s+(.*)$/) {
	269	$ret[-1]->{$key} = $value;
	270	next;
	271	}
	272
	273	if (my ($key, $value, $epoch, $tz) = $line =~ /^(author\|committer)\s+(.*)\s+(\d+)\s+([+-]\d+)$/) {
	274	$ret[-1]->{$key} = $value;
	275	eval {
	276	$ret[-1]->{ $key . "_datetime" } = DateTime->from_epoch(epoch => $epoch);
	277	$ret[-1]->{ $key . "_datetime" }->set_time_zone($tz);
	278	$ret[-1]->{ $key . "_datetime" }->set_formatter($formatter);
279	};
280
281	if ($@) {
282	$ret[-1]->{ $key . "_datetime" } = "$epoch $tz";
283	}
284
285	if (my ($name, $email) = $value =~ /^([^<]+)\s+<([^>]+)>$/) {
286	$ret[-1]->{ $key . "_name" } = $name;
287	$ret[-1]->{ $key . "_email" } = $email;
288	}
289	}
290
291	$line =~ s/^\n?\s{4}//;
292	$ret[-1]->{longmessage} = $line;
293	$ret[-1]->{message} = (split /\n/, $line, 2)[0];
294	}
295	}
296
297	return @ret;
298	}
299	}
300
301	sub list_revs {
302	my ($self, $project, %args) = @_;
303
304	$args{rev} \|\|= $self->get_head_hash($project);
305
306	my $output = $self->run_cmd_in($project, 'rev-list',
307	'--header',
308	(defined $args{ count } ? "--max-count=$args{count}" : ()),
309	(defined $args{ skip } ? "--skip=$args{skip}" : ()),
310	$args{rev},
311	'--',
312	($args{file} \|\| ()),
313	);
314	return unless $output;
315
316	my @revs = $self->parse_rev_list($output);
317
318	return \@revs;
319	}
320
321	sub rev_info {
322	my ($self, $project, $rev) = @_;
323
324	return unless $self->valid_rev($rev);
325
326	return $self->list_revs($project, rev => $rev, count => 1);
327	}
328
c5065c66	329	sub reflog {
	330	my ($self, $project, @logargs) = @_;
	331
	332	my @entries
	333	= $self->run_cmd_in($project, qw(log -g), @logargs)
	334	=~ /(^commit.+?(?:(?=^commit)\|(?=\z)))/msg;
	335
	336	=begin
	337
	338	commit 02526fc15beddf2c64798a947fecdd8d11bf993d
	339	Reflog: HEAD@{14} (The Git Server <git@git.dev.venda.com>)
	340	Reflog message: push
	341	Author: Iain Loasby <iloasby@rowlf.of-2.uk.venda.com>
	342	Date: Thu Sep 17 12:26:05 2009 +0100
	343
	344	Merge branch 'rt125181
	345	=cut
	346	return map {
	347	# XXX Stuff like this makes me want to switch to Git::PurePerl
	348	my($sha1, $type, $author, $date)
	349	= m{
	350	^ commit \s+ ([0-9a-f]+)$
	351	.*?
	352	Reflog[ ]message: \s+ (.+?)$ \s+
	353	Author: \s+ ([^<]+) <.*?$ \s+
	354	Date: \s+ (.+?)$
	355	}xms;
	356
	357	pos($_) = index($_, $date) + length $date;
	358	# Yeah, I just did that.
	359
	360	my($msg) = /\G\s+(\S.*)/sg;
	361
	362	{
	363	hash => $sha1,
	364	type => $type,
	365	author => $author,
	366	# XXX Add DateTime goodness.
	367	date => $date,
	368	message => $msg,
	369	};
	370	} @entries;
	371	}
	372
fbf3eb7e	373	sub get_heads {
	374	my ($self, $project) = @_;
	375
	376	my $output = $self->run_cmd_in($project, qw/for-each-ref --sort=-committerdate /, '--format=%(objectname)%00%(refname)%00%(committer)', 'refs/heads');
	377	return unless $output;
	378
	379	my @ret;
	380	for my $line (split /\n/, $output) {
	381	my ($rev, $head, $commiter) = split /\0/, $line, 3;
	382	$head =~ s!^refs/heads/!!;
	383
	384	push @ret, { rev => $rev, name => $head };
	385
	386	#FIXME: That isn't the time I'm looking for..
	387	if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
	388	my $dt = DateTime->from_epoch(epoch => $epoch);
	389	$dt->set_time_zone($tz);
	390	$ret[-1]->{last_change} = $dt;
	391	}
	392	}
	393
	394	return \@ret;
	395	}
	396
	397	sub archive {
	398	my ($self, $project, $rev) = @_;
	399
	400	#FIXME: huge memory consuption
	401	#TODO: compression
	402	return $self->run_cmd_in($project, qw/archive --format=tar/, "--prefix=${project}/", $rev);
	403	}
	404
	405	1;
	406
	407	__PACKAGE__->meta->make_immutable;