# Util.pm - utility functions for DebAux scripts

# Copyright (C) 2001,2005,2010 Stefan Hornburg  (Racke) <racke@linuxia.de>

# This file 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, or (at your option) any
# later version.

# This file 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 file; see the file COPYING.  If not, write to the Free
# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1301 USA.

=head1 NAME

DebAux::Util - utility functions for scripts of the debaux suite

=head1 SYNOPSIS

  use DebAux::Util;

  DebAux::Util::mkdir ('/path/to/a/directory');
  DebAux::Util::remove ('/path/to/a/directory');

  DebAux::Util::architecture ();

=head1 DESCRIPTION

This modules provides utility functions for scripts of the debaux
suite.

=head1 FUNCTIONS

=over 4

=item mkdir I<directory>

Creates I<directory> and any missing parent directories.

=back

=cut

package DebAux::Util;

use strict;
use Cwd;
use File::Find;

sub mkdir {
	my ($directory) = @_;
	my @frags = split (/\/+/, $directory);
	my $path;

	unless (length $frags[0]) {
		shift (@frags);
		$path = '/';
	}
	
	for (@frags) {
		$path .= $_;

		unless (-d $path) {
			mkdir ($path, 0777)
				|| die "$0: Couldn't create directory \"$path\"\n";
		}
		$path .= '/';
	}
}

=over 4

=item remove I<directory>

Removes recursively I<directory> in the way I<rm -rf> would do.

=back

=cut

sub remove {
	my ($directory) = @_;
	
	# proceed only if directory exists
	return unless -d $directory;

	my $sub = sub {
		my $cwd = cwd();

		# ignore special files
		return if $_ =~ /^\.\.?$/;

		if (-d $_ && ! -l $_) {
			# remove directory
			rmdir ($_)
				|| die "$0: Couldn't remove directory: $cwd/$_: $!\n";
		} else {
			# remove file
			unlink ($_)
				|| die "$0: Couldn't remove file: $cwd/$_: $!\n";
		}
	};

	my $cwd = cwd();

	finddepth ($sub, $directory);
	rmdir ($directory)
		|| die "$0: Couldn't remove directory: $cwd/$directory\n";
}

=over 4

=item architecture

Returns current architecture.

=back

=cut

sub architecture {
	my ($arch);

	$arch = `dpkg --print-architecture`;

	if ($@ || !$arch) {
		die "$0: failed to determine current architecture\n";
	}

	# remove trailing blanks
	$arch =~ s/\s+$//;
	
	return $arch;
}

1;

__END__

=head1 AUTHOR

Stefan Hornburg (Racke) <racke@linuxia.de>

=head1 LICENSE

DebAux::Util comes with ABSOLUTELY NO WARRANTY. This is free software, and
you are welcome to redistribute and modify it under the terms of the
GNU General Public License.

=head1 COPYRIGHT

Copyright 2001,2005,2010 Stefan Hornburg (Racke) <racke@linuxia.de>.

=cut
