view release on metacpan or  search on metacpan

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

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

=head1 NAME

Arch::Storage - abstract class to access arch archives