view release on metacpan or  search on metacpan

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

}

sub is_tla_functional () {
	eval { run_tla("help --help") } ? 1 : 0;
}

sub load_file ($;$) {
	my $file_name = shift;
	my $content_ref = shift;
	print STDERR "load_file: $file_name\n"
		if $ENV{DEBUG} && ("$ENV{DEBUG}" & "\4") ne "\0";
	open(FILE, "<$file_name") or die "Can't load $file_name: $!\n";
	local $/ = undef;
	my $content = <FILE>;
	close(FILE) or die "Can't close $file_name in load: $!\n";
	if ($content_ref) {
		$$content_ref = $content if ref($content_ref) eq 'SCALAR';
		if (ref($content_ref) eq 'ARRAY') {
			$content =~ s/\r?\n$//;
			@$content_ref = map { chomp; $_ } split(/\r?\n/, $content, -1);
		}
	}
	return defined wantarray? $content: undef;
}

sub save_file ($$) {
	my $file_name = shift;
	print STDERR "save_file: $file_name\n"
		if $ENV{DEBUG} && ("$ENV{DEBUG}" & "\4") ne "\0";
	open(FILE, ">$file_name") or die "Can't save $file_name: $!\n";
	print FILE
		ref($_[0]) eq 'SCALAR'? ${$_[0]}:
		ref($_[0]) eq 'ARRAY'? map { m|$/$|? $_: "$_$/" } @{$_[0]}:
		$_[0];
	close(FILE) or die "Can't close $file_name in save: $!\n";
	return 1;
}

sub copy_dir ($$) {
	my $dir1 = shift;
	my $dir2 = shift;
	my $out = run_cmd("/bin/cp -PRp", $dir1, $dir2);
	warn $out if $out;
}

sub remove_dir (@) {
	my @dirs = grep { $_ } @_;
	return unless @dirs;
	my $out = run_cmd("/bin/rm -rf", @dirs);
	warn $out if $out;
}

sub setup_config_dir (;$@) {
	my $dir = shift;
	$dir ||= $ENV{ARCH_MAGIC_DIR};
	$dir ||= ($ENV{HOME} || "/tmp") . "/.arch-magic";

	foreach my $subdir ("", @_) {
		next unless defined $subdir;
		$dir .= "/$subdir" unless $subdir eq "";
		stat($dir);
		die "$dir exists, but it is not a writable directory\n"
			if -e _ && !(-d _ && -w _);
		unless (-e _) {
			print STDERR "making dir: $dir\n"
				if $ENV{DEBUG} && ("$ENV{DEBUG}" & "\2") ne "\0";
			mkdir($dir, 0777) or die "Can't mkdir $dir: $!\n";
		}
	}
	return $dir;
}

my %months = (
	Jan => 1, Feb => 2, Mar => 3, Apr => 4, May => 5, Jun => 6,
	Jul => 7, Aug => 8, Sep => 9, Oct => 10, Nov => 11, Dec => 12,
);
sub standardize_date ($) {
	my $date = shift;
	if ($date =~ /\w+ (\w+) +(\d+) +(\d+):(\d+):(\d+) (\w+) (\d+)/) {
		$date = sprintf("%04d-%02d-%02d %02d:%02d:%02d %s",
			$7, $months{$1} || 88, $2, $3, $4, $5, $6);
	}
	return $date;
}

# return (creator_name, creator_email, creator_username)
sub parse_creator_email ($) {
	my $creator = shift;
	my $email = 'no@email.defined';
	my $username = "_none_";
	if ($creator =~ /^(.*?)\s*<((?:(.+?)@)?.*)>$/) {
		($creator, $email, $username) = ($1, $2, $3);
	}
	return ($creator, $email, $username);
}

sub adjacent_revision ($$) {
	my $full_revision = shift;
	my $offset = shift || die "adjacent_revision: no offset given\n";
	die "adjacent_revision: no working revision\n" unless $full_revision;

	$full_revision =~ /^(.*--.*?)(\w+)-(\d+)$/
		or die "Invalid revision ($full_revision)\n";
	my $prefix = $1;
	my $new_num = $3 + $offset;
	return undef if $new_num < 0;
	my $new_word = $2 =~ /^patch|base$/?
		$new_num? 'patch': 'base':
		$new_num? 'versionfix': 'version';
	return "$prefix$new_word-$new_num";
}

sub date2daysago ($) {
	my $date_str = shift;

	return -10000 unless $date_str =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2}) ([^\s]+)/;

	# timezone is not taken in account...
	require Time::Local;
	my $time = Time::Local::timegm($6, $5, $4, $3, $2 - 1, $1 - 1900);
	my $daysago = int((time - $time) / 60 / 60 / 24);