File Coverage

perllib/Arch/Backend.pm

Criterion	Covered	Total	%
statement	43	55	78.1
branch	7	20	35.0
condition	9	27	33.3
subroutine	22	23	95.6
pod	16	16	100.0
total	97	141	68.7

# Arch Perl library, Copyright (C) 2005 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::Backend;

use Arch::Util;

use Exporter;
use vars qw(@ISA @EXPORT_OK $EXE $NAME $VRSN $CACHE_CONFIG);

@ISA = qw(Exporter);
@EXPORT_OK = qw(
	arch_backend arch_backend_name arch_backend_version is_baz is_tla
	has_archive_setup_cmd has_file_diffs_cmd has_register_archive_name_arg
	has_tree_version_dir_opt has_tree_id_cmd has_set_tree_version_cmd
	has_cache_feature get_cache_config
	has_commit_version_arg has_commit_files_separator
	has_revlib_patch_set_dir
);

BEGIN {
	$EXE ||= $ENV{ARCH_BACKEND} || $ENV{TLA} || $ENV{BAZ} || "tla";
}

sub arch_backend (;$) {
	$EXE = shift if $_[0];
	return $EXE;
}

sub _parse_name_version () {
	my ($line1) = Arch::Util::run_tla("--version") || "";
	if ($line1 =~ /\b(tla|baz)(?:--.*--)?.*(\d+\.\d+(?:.\d+)?)/) {
		($NAME, $VRSN) = ($1, $2);
	} else {
		($NAME, $VRSN) = ("tla", "1.3");
		if ($EXE =~ /(tla|baz)(?:-(\d\.\d+(?:.\d+)?))/) {
			$NAME = $1;
			$VRSN = $2 if $2;
		}
		warn "Can't parse '$EXE --version' and determine arch backend name/version.\n"
			. "Please check \$ARCH_BACKEND and optionally notify arch-perl developers.\n"
			. "Assuming ($NAME, $VRSN). Set \$ARCH_PERL_QUIET to disable this warning.\n"
			unless $ENV{ARCH_PERL_QUIET};
	}
	#print "arch_backend name and version: ($NAME, $VRSN)\n";
	return ($NAME, $VRSN);
}

sub arch_backend_name () {
	return $NAME ||= (_parse_name_version)[0];
}

sub arch_backend_version () {
	return $VRSN ||= (_parse_name_version)[1];
}

sub is_baz () {
	return arch_backend_name() eq "baz";
}

sub is_tla () {
	return arch_backend_name() eq "tla";
}

sub has_archive_setup_cmd () {
	return is_tla();
}

sub has_file_diffs_cmd () {
	return is_tla() && arch_backend_version() =~ /^1\.[12]/;
}

sub has_register_archive_name_arg () {
	return is_tla();
}

sub has_tree_version_dir_opt () {
	return is_baz();
}

sub has_tree_id_cmd () {
	return is_baz();
}

sub has_set_tree_version_cmd () {
	return is_tla();
}

sub has_cache_feature () {
	return is_baz();
}

sub get_cache_config () {
	unless ($CACHE_CONFIG) {
		my $output = "";

		if (has_cache_feature()) {
			# baz-1.1 .. baz-1.3.2 prints on stderr instead of stdout
			my $baz_is_buggy = 1;
			if ($baz_is_buggy) {
				my $file = "$ENV{HOME}/.arch-params/=arch-cache";
				if (-f $file) {
					my $dir = Arch::Util::load_file($file);
					$dir =~ s/\r?\n.*//s;
					$output = "Location: $dir\n" if $dir && -d $dir;
				}
			} else {
				$output = Arch::Util::run_tla("cache-config");
			}
		}

		my $location = $output =~ /^Location: (.*)/m && $1 || undef;
		$CACHE_CONFIG = {
			dir => $location,
		};
	}
	return $CACHE_CONFIG;
}

sub has_commit_version_arg () {
	return is_tla() || is_baz() && arch_backend_version() =~ /^1\.[0123]/;
}

sub has_commit_files_separator () {
	return has_commit_version_arg();
}

sub has_revlib_patch_set_dir () {
	return is_tla() || is_baz() && arch_backend_version() =~ /^1\.[0123]/;
}

1;

__END__