File Coverage

perllib/Arch/RevisionBunches.pm

Criterion	Covered	Total	%
statement	9	157	5.7
branch	0	62	0.0
condition	0	54	0.0
subroutine	3	14	21.4
pod	9	9	100.0
total	21	296	7.0

# Arch Perl library, Copyright (C) 2004 Mikhael Goikhman
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use 5.005;
use strict;

package Arch::RevisionBunches;

use Arch::Util qw(date2daysago);

sub new ($%) {
	my $class = shift;
	my %args = @_;

	my $self = {
		bunched_revision_descs => [],
		new_revision_descs => [],
		bunches => [],
		versions => [],
		filepaths => [],
		bunch_size => 50,
		max_sumlen => undef,
		version => undef,
		final_revision => undef,
		final_filepath => undef,
		cb_remove_all_bunches => undef,
		cb_add_new_bunch => undef,
	};
	bless $self, $class;
	return $self->init(%args);
}

sub init ($%) {
	my $self = shift;
	my %args = @_;

	while (my ($key, $value) = each %args) {
		unless (exists $self->{$key}) {
			warn "Arch::RevisionBunches: unknown key $key, ignoring\n";
			next;
		}
		$self->{$key} = $value;
	}
	$self->{max_sumlen} = undef if $args{max_sumlen} &&
		!($args{max_sumlen} =~ /^\d+$/ && $args{max_sumlen} > 5);
	return $self;
}

sub add_revision_descs ($$%) {
	my $self = shift;
	my $revision_descs = shift;
	my %args = @_;
	my $max_sumlen = $self->{max_sumlen};

	foreach (@$revision_descs) {
		substr($_->{summary}, $max_sumlen - 3) = "..."
			if $max_sumlen && length($_->{summary}) > $max_sumlen;
		foreach my $arg (keys %args) {
			$_->{$arg} = $args{$arg};
		}
	}
	push @{$self->{new_revision_descs}}, @$revision_descs;
	return $self;
}

sub get ($) {
	my $self = shift;
	$self->rebunch if @{$self->{new_revision_descs}};
	return wantarray? @{$self->{bunches}}: $self->{bunches};
}

sub _set_bunch_interval_data ($$;$) {
	my $self = shift;
	my $bunch = shift || die;
	my $start_index = shift || 0;

	my $nr = @{$bunch->{revision_descs}};
	my $i = 1;
	my $idx2 = $nr > 1 ? -1 : undef;
	foreach my $idx (0, $idx2) {
		my $revision_desc = defined $idx && $bunch->{revision_descs}->[$idx];
		$bunch->{"name$i"} = $revision_desc? $revision_desc->{name}: undef;
		my ($daysago, $time, $tz) = $revision_desc?
			date2daysago($revision_desc->{date}): (undef) x 3;
		$bunch->{"daysago$i"} = $daysago;
		$bunch->{"time$i"} = $time;
		$bunch->{"tz$i"} = $tz;
		$i++;
	}
	$bunch->{size} = $nr;

	my %creators = ();
	my $nm = 0;
	foreach my $revision_desc (@{$bunch->{revision_descs}}) {
		my $creator = $revision_desc->{creator} || "";
		my $email = $revision_desc->{email} || "";
		my $entry = $creators{$creator,$email} ||= [ $creator, $email, 0 ];
		$entry->[2]++;
		$nm++ if $revision_desc->{is_merged};
	}
	my $nc = $bunch->{num_creators} = scalar keys %creators;
	$bunch->{num_other_creators} = $nc? $nc - 1: 0;
	($bunch->{main_creator}, $bunch->{main_email}) =
		@{ (sort { $b->[2] <=> $a->[2] } values %creators)[0] || [] };
	$bunch->{creator} = $bunch->{main_creator} . ($nc == 1? "": " among $nc creators");

	$bunch->{name} = $bunch->{name1};
	$bunch->{date} = $bunch->{daysago1};
	if ($bunch->{name2}) {
		$bunch->{name} .= " .. $bunch->{name2}";
		$bunch->{date} .= " .. $bunch->{daysago2}";
	}
	$bunch->{date} .= " days ago";
	$bunch->{summary} = "$nr revision" . ($nr == 1? "": "s");
	$bunch->{summary} .= ' (missing)' if $bunch->{is_missing} && $nm < $nr;
	$bunch->{summary} .= " ($nm merged)" if $nm > 0;

	$self->{cb_add_new_bunch}->($bunch, $start_index) if $self->{cb_add_new_bunch};
}

sub _invalidate_bunches ($) {
	my $self = shift;

	$self->{cb_remove_all_bunches}->() if $self->{cb_remove_all_bunches};

	unshift @{$self->{new_revision_descs}}, @{$self->{bunched_revision_descs}};
	@{$self->{bunched_revision_descs}} = ();
	@{$self->{bunches}} = ();
	@{$self->{versions}} = ();
	@{$self->{filepaths}} = ();
}

sub rebunch ($;$) {
	my $self = shift;
	my $bunch_size = shift;
	my $change_size = !!$bunch_size;
	$bunch_size ||= $self->{bunch_size} || die "No bunch size given";

	if ($change_size) {
		$self->{bunch_size} = $bunch_size;
		$self->_invalidate_bunches;
	}
	goto RETURN unless @{$self->{new_revision_descs}};

	my $last_bunch = $self->{bunches}->[-1];
	my $start_index = $last_bunch? @{$last_bunch->{revision_descs}}: 0;
	my $multi_version = !$self->{version};
	while (my $rd = shift @{$self->{new_revision_descs}}) {
		my $version = $rd->{version};
		my $is_missing = $rd->{is_missing};
		my $has_is_missing = defined $is_missing;
		my $filepath = $rd->{filepath};
		my $has_filepath = defined $filepath;
		my $is_bunch_property_changed = 0;

		if ($last_bunch && $multi_version && $last_bunch->{version} ne $version) {
			push @{$self->{versions}}, $version;
			$is_bunch_property_changed = 1;
		}
		if ($last_bunch && $has_is_missing && $last_bunch->{is_missing} ne $is_missing) {
			$is_bunch_property_changed = 1;
		}
		if (!$last_bunch || $has_filepath && $last_bunch->{filepath} ne $filepath) {
			push @{$self->{filepaths}}, $filepath;
			$is_bunch_property_changed = 1;
		}

		if (
			!$last_bunch || $is_bunch_property_changed ||
			@{$last_bunch->{revision_descs}} >= $bunch_size
		) {
			$self->_set_bunch_interval_data($last_bunch, $start_index) if $last_bunch;
			$start_index = 0;
			$last_bunch = { revision_descs => [] };
			$last_bunch->{version} = $version if $multi_version;
			$last_bunch->{filepath} = $filepath if $has_filepath;
			$last_bunch->{is_missing} = $is_missing if $has_is_missing;
			push @{$self->{bunches}}, $last_bunch;
		}
		push @{$last_bunch->{revision_descs}}, $rd;
		push @{$self->{bunched_revision_descs}}, $rd;
	}
	$self->_set_bunch_interval_data($last_bunch, $start_index) if $last_bunch;

	RETURN:
	return wantarray? @{$self->{bunches}}: $self->{bunches};
}

sub clear ($) {
	my $self = shift;

	$self->_invalidate_bunches;
	@{$self->{new_revision_descs}} = @{$self->{bunched_revision_descs}} = ();
	return $self;
}

sub reverse_revision_descs ($) {
	my $self = shift;

	$self->_invalidate_bunches;
	@{$self->{new_revision_descs}} = reverse(@{$self->{new_revision_descs}});
	return $self;
}

sub versions ($) {
	my $self = shift;
	return $self->{versions};
}

sub filepaths ($) {
	my $self = shift;
	return $self->{filepaths};
}

1;

__END__