view release on metacpan or  search on metacpan

perllib/Arch/Tree.pm  view on Meta::CPAN

		my $summary = $2;
		$summary =~ s/^   //g;
		$summary =~ s/\n$//;
		push @hash, $summary;
	}
	die "Unexpected merged log sub-output:\n$text\n" if $text ne "";

	return @hash if wantarray;
	my %hash = @hash;
	return \%hash;
}

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

	my $revision_summaries = $self->get_merged_revision_summaries;
	my @array = sort keys %$revision_summaries;
	return wantarray ? @array : \@array;
}

sub get_missing_revisions ($;$) {
	my $self = shift;
	my $version = shift || $self->get_version;

	$self->{missing_revisions}->{$version} ||= [
		run_tla("missing", "-d", $self->{dir}, $version)
	];
	my $array = $self->{missing_revisions}->{$version};
	return wantarray ? @$array : $array;
}

sub get_missing_revision_descs ($;$) {
	my $self = shift;
	my $version = shift || $self->get_version;

	unless ($self->{missing_revision_descs}->{$version}) {
		my @revision_lines =
			map { /^\S/? (undef, $_): $_ }
			run_tla("missing -scD", "-d", $self->{dir}, $version);
		shift @revision_lines;  # throw away first undef

		my $revision_descs = _parse_revision_descs(4, \@revision_lines);
		$self->{missing_revision_descs}->{$version} = $revision_descs;
		$self->{missing_revisions}->{$version} =
			[ map { $_->{name} } @$revision_descs ];
	}
	return $self->{missing_revision_descs}->{$version};
}

# for compatibility only, may be removed after summer 2005
*get_missing_revision_details = *get_missing_revision_descs;
*get_missing_revision_details = *get_missing_revision_details;

sub get_previous_revision ($;$) {
	my $self = shift;
	my $revision = shift || $self->get_revision;

	return adjacent_revision($revision, -1)
		unless $revision =~ /^(.*)--version-0$/;

	# handle version-0 case specially, can't be guessed from the name alone
	my $revisions = $self->get_log_revisions($1);
	until (pop @$revisions eq $revision) {
	}
	return $revisions->[-1];
}

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

	my $limit = $args{limit} || 0;
	my $callback = $args{callback};
	my $one_version = $args{one_version} || 0;
	my $no_continuation = $args{no_continuation} || 0;

	my @collected = ();
	my $version = $self->get_version if $one_version;
	my $revision = $self->get_revision;
	while ($revision) {
		my $log = $self->get_log($revision);

		# handle removed logs
		unless ($log) {
			$revision = $self->get_previous_revision($revision);
			next;
		}

		my $kind = $log->get_revision_kind;
		if ($kind eq 'import') {
			$revision = undef;
		} elsif ($kind eq 'tag') {
			$revision = $no_continuation
				? undef
				: $log->continuation_of;
			$revision &&= undef
				if $one_version && $revision !~ /^\Q$version--/;
		} else {
			$revision = $self->get_previous_revision($revision);
		}
		push @collected, $callback? $callback->($log): $log;
		last unless --$limit && $log;  # undefined by callback
	}
	return \@collected;
}

# for compatibility only, may be removed after summer 2005
sub iterate_ancestry_logs ($;$$) {
	my $self = shift;
	my $cb = shift;
	my $nc = shift || 0;
	return $self->get_ancestry_logs(callback => $cb, no_continuation => $nc);
}

sub get_history_revision_descs ($;$%) {
	my $self = shift;
	my $filepath = shift;
	@_ = (one_version => $_[0]) if @_ == 1;  # be compatible until summer 2005
	my %args = @_;

	my $limit = delete $args{limit} || 0;