# 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 ArchWay::Util::TreeVersions;

use Arch::Util qw(load_file save_file);

use constant TYPE_NEW    => 'new';
use constant TYPE_ACTIVE => 'active';
use constant TYPE_HIDDEN => 'hidden';

use constant KINSHIP_REMOTE  => 'remote';
use constant KINSHIP_UPSTR   => 'upstream';
use constant KINSHIP_DOWNSTR => 'downstream';
use constant KINSHIP_PARENT  => 'parent';
use constant KINSHIP_CHILD   => 'child';
use constant KINSHIP_BROTHER => 'brother';
use constant KINSHIP_SELF    => 'self';
use constant KINSHIP_EXSELF  => 'exself';

use constant ROLE_REGULAR  => 'regular';
use constant ROLE_MAINLINE => 'mainline';
use constant ROLE_DEVEL    => 'devel';
use constant ROLE_RELEASE  => 'release';
use constant ROLE_PRERELEA => 'prerelea';
use constant ROLE_STABLE   => 'stable';
use constant ROLE_UNSTABLE => 'unstable';
use constant ROLE_TESTING  => 'testing';
use constant ROLE_ALPHA    => 'alpha';
use constant ROLE_BETA     => 'beta';
use constant ROLE_GAMMA    => 'gamma';
use constant ROLE_MINORFIX => 'minorfix';
use constant ROLE_MAJORFIX => 'majorfix';
use constant ROLE_FEATURE  => 'feature';
use constant ROLE_ROTATED  => 'rotated';
use constant ROLE_OBSOLETE => 'obsolete';

sub new ($$) {
	my $class = shift;
	my $tree = shift || die "ArchWay::Util::TreeVersions: no tree\n";
	my $file = "$tree->{dir}/{arch}/+archway-versions";

	my $self = {
		tree => $tree,
		file => $file,
	};
	bless $self, $class;

	$self->load;
	return $self;
}

sub load ($) {
	my $self = shift;
	my $version_lines = [];
	load_file($self->{file}, $version_lines) if -f $self->{file};
	my %entries = ();
	foreach (@$version_lines) {
		next unless /^([^\s]+)\t(\w+)\t(\w+)\t(\w+)\t(.*)$/;
		$entries{$1} = { type => $2, kinship => $3, role => $4, label => $5 };
	}
	$self->{entries} = \%entries;
	$self->sync;
	return $self;
}

sub sync ($) {
	my $self = shift;
	my @log_versions = $self->{tree}->get_log_versions;
	my $self_version = $self->{tree}->get_version;
	foreach my $version (@log_versions) {
		my $old_entry = $self->{entries}->{$version};
		if ($old_entry) {
			$old_entry->{type} = TYPE_ACTIVE
				if $old_entry->{type} eq TYPE_NEW;
			$old_entry->{kinship} = KINSHIP_SELF
				if $version eq $self_version;
			$old_entry->{kinship} = KINSHIP_EXSELF
				if $old_entry->{kinship} eq KINSHIP_SELF && $version ne $self_version;
			next;
		}
		my $kinship = KINSHIP_REMOTE;
		$kinship = KINSHIP_SELF if $version eq $self_version;
		$self->{entries}->{$version} = {
			type    => TYPE_ACTIVE,
			kinship => $kinship,
			role    => ROLE_REGULAR,
			label   => "",
		};
	}
	return $self;
}

sub save ($) {
	my $self = shift;
	my @version_lines = map {
		my $entry = $self->{entries}->{$_};
		join("\t", $_, map { $entry->{$_} } qw(type kinship role label));
	} sort keys %{$self->{entries}};
	save_file($self->{file}, \@version_lines);
	return $self;
}

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

sub get ($$) {
	my $self = shift;
	my $version = shift;
	return $self->{entries}->{$version};
}

sub set ($$%) {
	my $self = shift;
	my $version = shift;
	my %args = @_;
	my $entry = $self->{entries}->{$version};
	$entry ||= {
		type    => TYPE_NEW,
		kinship => KINSHIP_CHILD,
		role    => ROLE_REGULAR,
		label   => "",
	};

	foreach my $prop (qw(type kinship role)) {
		if ($args{$prop}) {
			my $method = "${prop}_choices";
			my $changeable = $self->$method($entry->{$prop});
			die "Unknown $prop value ($args{$prop})\n"
				unless defined $changeable;
			die "Can't change $prop from $entry->{$prop} to $args{$prop}\n"
				unless $changeable;
			$entry->{$prop} = $args{$prop};
		}
	}
	if (defined $args{label}) {
		$entry->{label} = $args{label};
	}

	$self->{entries}->{$version} = $entry;
}

sub type_choices ($$) {
	my $self = shift;
	my $value = shift;
	my $changeable = $value ne TYPE_NEW;
	return (
		TYPE_NEW()    => !$changeable,
		TYPE_ACTIVE() => $changeable,
		TYPE_HIDDEN() => $changeable,
	);
}

sub kinship_choices ($$) {
	my $self = shift;
	my $value = shift;
	my $changeable = $value ne KINSHIP_SELF;
	return (
		KINSHIP_REMOTE()  => $changeable,
		KINSHIP_UPSTR()   => $changeable,
		KINSHIP_DOWNSTR() => $changeable,
		KINSHIP_PARENT()  => $changeable,
		KINSHIP_CHILD()   => $changeable,
		KINSHIP_BROTHER() => $changeable,
		KINSHIP_SELF()    => $value eq KINSHIP_SELF,
		KINSHIP_EXSELF()  => $value eq KINSHIP_EXSELF,
	);
}

sub role_choices ($$) {
	my $self = shift;
	my $value = shift;
	return (
		ROLE_REGULAR()  => 1,
		ROLE_MAINLINE() => 1,
		ROLE_DEVEL()    => 1,
		ROLE_RELEASE()  => 1,
		ROLE_PRERELEA() => 1,
		ROLE_STABLE()   => 1,
		ROLE_UNSTABLE() => 1,
		ROLE_TESTING()  => 1,
		ROLE_ALPHA()    => 1,
		ROLE_BETA()     => 1,
		ROLE_GAMMA()    => 1,
		ROLE_MINORFIX() => 1,
		ROLE_MAJORFIX() => 1,
		ROLE_FEATURE()  => 1,
		ROLE_ROTATED()  => 1,
		ROLE_OBSOLETE() => 1,
	);
}

sub tree {
	my $self = shift;
	
	return $self->{"tree"};
}

1;

__END__

=head1 NAME

ArchWay::Util::TreeVersions - manage meta-data of project partner versions

=head1 SYNOPSIS

    use ArchWay::Util::TreeVersions;
    use Arch::Tree;

    my $tv = ArchWay::Util::TreeVersions->new(Arch::Tree->new);
    my $parent_entry = $tv->all->{$parent_version};
    $parent_entry->{type}    = "hidden";
    $parent_entry->{kinship} = "parent";
    $parent_entry->{role}    = "rotated";
    $parent_entry->{label}   = "Ancient Branch";

    my $some_entry = $tv->get($some_version);
    $tv->set('my@host--archive/cat--brn--0', kinship => "child");
    $tv->save;

=head1 DESCRIPTION

This class manages I<./{arch}/+archway-versions> file in the project tree.

The format of this file is one line "I<version> I<type> I<kinship> I<label>"
for each tree log version (and possibly new unmerged partner versions too).
Where I<type> is integer: 0=hidden, 1=active, 2=new.

=head1 METHODS

The following class methods are available:

B<new>,
B<load>,
B<sync>,
B<save>,
B<all>,
B<get>,
B<set>,
B<type_choices>,
B<kinship_choices>.

=over 4

=item B<new>

Constructs the object that deals with meta-data of partner versions.

=item B<load>

Loads the state file and initializes the data. The old data (if any) is lost
if not B<save>'d earlier. This method, B<load>, calls B<sync> automatically.
This method is called in constructor.

=item B<save>

Saves the data to the state file.

=item B<sync>

Synchronize the data with the actual log-versions of the tree. This adds
all new (or all if no file initialy exists) versions. Every added I<version>
gets I<type>=1, I<kinship>="remote" and empty I<label>.

=item B<all>

Returns hashref (keys are versions) of hashes with keys: I<type>,
I<kinship> and I<label>, as described above. The returned data structure
may be modified in place, but it is better to use B<entry> method.

=item B<get> I<version>

Returns hashref with keys: I<type>, I<kinship> and I<label>.
Returns undef on unexisting I<version>.

=item B<set> I<version> I<field-hash>

Updates the existing I<version> entry or adds a new one. I<field-hash> is
a possibly incomplete hash (not hashref) with keys: I<type>, I<kinship>
and I<label>. By default the I<kinship> is "remote", I<type> is "new",
I<role> is "regular" and I<label> is empty.

All fields except for I<label> are limited to a list of predefined
values and there are certain constraints. For example, I<type> can't be
changed from and to "new", any version gets the value "new" when initially
added, and it is possibly replaced with "active" automatically when
synchronized with the real tree versions. Similarly with I<kinship> "self".

=item B<type_choices> I<current_value>

Returns hash (actually ordered array of pairs) of all possible type choices
given the I<current_value>. The hash value is boolean meaning changeability.

=item B<kinship_choices> I<current_value>

Returns hash (actually ordered array of pairs) of all possible kinship choices
given the I<current_value>. The hash value is boolean meaning changeability.

=item B<role_choices> I<current_value>

Returns hash (actually ordered array of pairs) of all possible role choices
given the I<current_value>. The hash value is boolean meaning changeability.

=back

=head1 BUGS

No known bugs.

=head1 AUTHORS

Mikhael Goikhman (migo@homemail.com--Perl-GPL/archway--devel).

=head1 SEE ALSO

For more information, see L<Arch::Tree>.

=cut
