view release on metacpan or  search on metacpan

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

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

use base 'Arch::Storage';

use Arch::Util qw(run_tla load_file standardize_date parse_creator_email date2age);
use Arch::Changeset;
use Arch::Log;
use Arch::Backend qw(has_revlib_patch_set_dir);
use Arch::TempFiles qw(temp_dir);

sub _default_fields ($) {
	my $this = shift;
	return (
		$this->SUPER::_default_fields,
		fallback_dir => undef,
		ready_to_add => 0,
		path => undef,
		working_revision => undef,
		revision_trees => {},
	);
}

sub archives ($) {
	my $self = shift;
	return [ run_tla('library-archives') ];
}

sub categories ($;$) {
	my $self = shift;
	my $archive = shift || $self->working_name;
	return [ run_tla('library-categories', $archive) ];
}

sub branches ($;$) {
	my $self = shift;
	my $full_category = shift || $self->working_name;
	return [ run_tla('library-branches', $full_category) ];
}

sub versions ($;$) {
	my $self = shift;
	my $full_branch = shift || $self->working_name;
	return [ run_tla('library-versions', $full_branch) ];
}

sub revisions ($;$) {
	my $self = shift;
	my $full_version = shift || $self->working_name;
	return [ run_tla('library-revisions', $full_version) ];
}

sub get_revision_descs ($;$) {
	my $self = shift;
	my $full_version = shift || $self->working_name;
	my @lines = run_tla('library-revisions -Dcs', $full_version);

	my @revision_descs = ();
	while (@lines) {
		my ($name, $date, $creator) = splice @lines, 0, 3;
		die "Unexpected date line ($date) in tla library-revisions -Dcs\n"
			unless $date =~ s/^    //;
		die "Unexpected creator line ($creator) in tla library-revisions -Dcs\n"
			unless $creator =~ s/^    //;

		my @summary_lines = ();
		push @summary_lines, shift @lines while @lines && $lines[0] =~ /^    |^\t/;
		my $summary = join("\n", @summary_lines);
		$summary =~ s/^    |^\t//mg;

		$date = standardize_date($date);
		my $age = date2age($date);
		my ($creator1, $email, $username) = parse_creator_email($creator);

		push @revision_descs, {