File Coverage

perllib/Arch/Storage.pm

Criterion	Covered	Total	%
statement	15	95	15.7
branch	0	28	0.0
condition	0	6	0.0
subroutine	5	15	33.3
pod	8	8	100.0
total	28	152	18.4

# 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::Storage;

use Arch::Name;

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

	my $self = { $class->_default_fields };
	bless $self, $class;
	$self->init(%init);

	no strict 'refs';
	${"${class}::global_instance"} = $self;
	return $self;
}

sub instance ($) {
	my $class = shift;

	no strict 'refs';
	return ${"${class}::global_instance"} || $class->new;
}

sub init ($%) {
	my $self = shift;
	my %init = @_;
	while (my ($name, $value) = each %init) {
		die ref($self) . "::init: Option $name is unknown.\n"
			unless exists $self->{$name};
		$self->{$name} = $value;
	}
	return $self;
}

sub _default_fields ($) {
	my $this = shift;
	return (
		name => Arch::Name->new,
	);
}

sub working_name ($;$) {
	my $self = shift;
	if (@_) {
		$self->{name} = Arch::Name->new(shift);
		$self->fixup_name_alias;
	}
	return $self->{name};
}

sub working_names ($;$@) {
	my $self = shift;
	if (@_) {
		$self->{name} = Arch::Name->new(ref($_[0])? $_[0]: [ @_ ]);
	}
	return $self->{name}->get;
}

sub fixup_name_alias ($) {
	my $self = shift;
	$self->{name_alias} = 0;
	$self->{version_alias} = undef;
	$self->{revision_alias} = undef;

	my $name = $self->{name};
	my ($version, $revision) = ($name->get)[3, 4];
	foreach (
		[ qw(version versions branch), $version ],
		[ qw(revision revisions version), $revision ]
	) {
		my ($element, $method, $parent, $alias) = @$_;
		if (defined $alias && $alias =~ /^FIRST|LATEST$/) {
			$name->$element(undef);
			my $values = $self->$method($name);
			die "There is no any $element in this $parent, so $name--$alias alias is invalid\n"
				unless @$values;
			my $value = $values->[$alias eq "FIRST"? 0: -1];
			$value =~ s/^.*--//;
			$name->$element($value);
			$name->revision($revision) unless $element eq 'revision';
			$self->{name_alias} = 1;
			$self->{"${element}_alias"} = $alias;
		}
	}
}

sub _name_operand ($$;$) {
	my $self = shift;
	my $arg  = shift;
	my $elem = shift;
	my $func = (caller(1))[3];

	my $name = $arg? Arch::Name->new($arg): $self->{name};
	die "$func: no working name and no argument given\n" unless $name;
	if ($elem) {
		my $enclosing = $name->cast($elem);
		die "$func: operand '$name' is not $elem\n" unless $enclosing;
		$name = $enclosing;
	}
	return $name;
}

sub is_archive_managed ($;$) {
	my $self = shift;
	my $archive = $self->_name_operand(shift, 'archive');

	unless ($self->{archives_presence}) {
		my $archives_hash = {};
		$archives_hash->{$_} = 1 foreach @{$self->archives};
		$self->{archives_presence} = $archives_hash;
	}
	return $self->{archives_presence}->{$archive};
}

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

	my $all_revisions = [];
	my $archives = $self->archives;
	foreach my $archive (@$archives) {
		my $category_infos = $self->expanded_archive_info($archive, 1);
		foreach my $category_info (@$category_infos) {
			my ($category, $branch_infos) = @$category_info;
			foreach my $branch_info (@$branch_infos) {
				my ($branch, $version_infos) = @$branch_info;
				foreach my $version_info (@$version_infos) {
					my ($version, @revisions) = @$version_info;
					foreach my $revision (@revisions) {
						my $name = Arch::Name->new([
							$archive, $category, $branch, $version, $revision,
						]);
						die $name->error .
							"\n\t($archive, $category, $branch, $version, $revision)\n"
							if $name->error;
						push @$all_revisions, $name;
					}
				}
			}
		}
	}

	return $all_revisions;
}

1;

__END__