Remove unused Perl modules Xen::Tools and Xen::Tools::Log
Further developement of the (if any) will happen in the git branch "xen-tools-moose" where they are still available. Also remove the according (already disabled) tests and test modifications from the test suite. Also remove no the more needed build-dependency on Moose as well as one Makefile line installing the above mentioned Perl modules.
This commit is contained in:
Axel Beckert
1
Makefile
1
Makefile
@@ -210,7 +210,6 @@ install-hooks:
|
||||
#
|
||||
install-libraries:
|
||||
-mkdir -p ${prefix}/usr/share/perl5/Xen/Tools
|
||||
cp ./lib/Xen/*.pm ${prefix}/usr/share/perl5/Xen
|
||||
cp ./lib/Xen/Tools/*.pm ${prefix}/usr/share/perl5/Xen/Tools
|
||||
|
||||
#
|
||||
|
||||
3
debian/changelog
vendored
3
debian/changelog
vendored
@@ -48,6 +48,9 @@ xen-tools (4.4~dev-1) UNRELEASED; urgency=low
|
||||
- Fixes creation of "ARRAY(0x…).log" named log files.
|
||||
- Makes some options (like --pygrub) negatable.
|
||||
- Uses Test::NoTabs; add according build-dependency.
|
||||
- Removes unused Perl modules Xen::Tools and Xen::Tools::Log from
|
||||
source code. Also removes the according tests from the test suite.
|
||||
→ Remove no more needed build-dependency on Moose.
|
||||
* Add debian/gbp.conf to be able to to build xen-tools with
|
||||
git-buildpackage.
|
||||
* Clean up debian/rules:
|
||||
|
||||
1
debian/control
vendored
1
debian/control
vendored
@@ -7,7 +7,6 @@ Build-Depends: debhelper (>= 7.0.0),
|
||||
git,
|
||||
libfile-slurp-perl,
|
||||
libfile-which-perl,
|
||||
libmoose-perl,
|
||||
libtest-notabs-perl,
|
||||
libtest-pod-coverage-perl,
|
||||
libtest-pod-perl,
|
||||
|
||||
332
lib/Xen/Tools.pm
332
lib/Xen/Tools.pm
@@ -1,332 +0,0 @@
|
||||
package Xen::Tools;
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
use Moose;
|
||||
|
||||
use Xen::Tools::Log;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Xen::Tools - Build Xen domains with Perl
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Version 0.01
|
||||
|
||||
=cut
|
||||
|
||||
our $VERSION = '0.01';
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my $xt = Xen::Tools->new();
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
=head2 new
|
||||
|
||||
Instantiate the object.
|
||||
|
||||
=cut
|
||||
|
||||
override 'new' => sub {
|
||||
my $class = shift;
|
||||
|
||||
# Initialize the base class
|
||||
my $self = $class->super(@_);
|
||||
|
||||
$self->{_xtl} = Xen::Tools::Log->new( hostname => $self->hostname,
|
||||
logpath => $self->logpath,
|
||||
);
|
||||
|
||||
$self->_checkSystem();
|
||||
|
||||
return $self;
|
||||
};
|
||||
|
||||
=head2 meta
|
||||
|
||||
This is a method which provides access to the current class's meta-
|
||||
class. Inherited from Moose.
|
||||
|
||||
=cut
|
||||
|
||||
=head2 log
|
||||
|
||||
This method sends a log message to the current object's logging
|
||||
mechanism
|
||||
|
||||
=cut
|
||||
|
||||
sub log {
|
||||
my $self = shift;
|
||||
|
||||
$self->{_xtl}->print(@_);
|
||||
}
|
||||
|
||||
=head2 hostname
|
||||
|
||||
Attribute which indicates the domain's hostname
|
||||
|
||||
=cut
|
||||
|
||||
has 'hostname' => ( is => 'ro', isa => 'Str', required => 1 );
|
||||
|
||||
=head2 logpath
|
||||
|
||||
Attribute which indicates the log directory. Defaults to /var/log/xen-tools
|
||||
|
||||
=cut
|
||||
|
||||
has 'logpath' => ( is => 'ro',
|
||||
isa => 'Str',
|
||||
default => '/var/log/xen-tools'
|
||||
);
|
||||
|
||||
=begin doc
|
||||
|
||||
_findBinary
|
||||
|
||||
Find the location of the specified binary on the curent user's PATH.
|
||||
|
||||
Return undef if the named binary isn't found.
|
||||
|
||||
=end doc
|
||||
|
||||
=cut
|
||||
|
||||
sub _findBinary {
|
||||
my $self = shift;
|
||||
my( $bin ) = (@_);
|
||||
|
||||
# strip any path which might be present.
|
||||
$bin = $2 if ( $bin =~ /(.*)[\/\\](.*)/ );
|
||||
|
||||
foreach my $entry ( split( /:/, $ENV{'PATH'} ) )
|
||||
{
|
||||
# guess of location.
|
||||
my $guess = $entry . "/" . $bin;
|
||||
|
||||
# return it if it exists and is executable
|
||||
return $guess if ( -e $guess && -x $guess );
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
=begin doc
|
||||
|
||||
_checkSystem
|
||||
|
||||
Test that this system is fully setup for the new xen-create-image
|
||||
script.
|
||||
|
||||
This means that the the companion scripts xt-* are present on the
|
||||
host and executable.
|
||||
|
||||
=end doc
|
||||
|
||||
=cut
|
||||
|
||||
sub _checkSystem {
|
||||
my $self = shift;
|
||||
my @required = qw ( / xt-customize-image
|
||||
xt-install-image
|
||||
xt-create-xen-config / );
|
||||
|
||||
foreach my $bin ( @required )
|
||||
{
|
||||
if ( ! defined( $self->_findBinary( $bin ) ) )
|
||||
{
|
||||
$self->log("The script '$bin' was not found.\n",
|
||||
"Aborting\n\n"
|
||||
);
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Make sure that we have Text::Template installed - this
|
||||
# will be used by `xt-create-xen-config` and if that fails then
|
||||
# running is pointless.
|
||||
#
|
||||
my $test = "use Text::Template";
|
||||
eval( $test );
|
||||
if ( ( $@ ) && ( ! $self->{_force} ) )
|
||||
{
|
||||
print <<E_O_ERROR;
|
||||
|
||||
Aborting: The Text::Template perl module isn't installed or available.
|
||||
|
||||
Specify '--force' to skip this check and continue regardless.
|
||||
|
||||
E_O_ERROR
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Make sure that xen-shell is installed if we've got an --admin
|
||||
# flag specified
|
||||
#
|
||||
if ( $self->{_admins} )
|
||||
{
|
||||
my $shell = undef;
|
||||
$shell = "/usr/bin/xen-login-shell" if ( -x "/usr/bin/xen-login-shell" );
|
||||
$shell = "/usr/local/bin/xen-login-shell" if ( -x "/usr/bin/local/xen-login-shell" );
|
||||
|
||||
if ( !defined( $shell ) )
|
||||
{
|
||||
print <<EOF;
|
||||
|
||||
You've specified administrator accounts for use with the xen-shell,
|
||||
however the xen-shell doesn't appear to be installed.
|
||||
|
||||
Aborting.
|
||||
EOF
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Test the system has a valid (network-script) + (vif-script) setup.
|
||||
#
|
||||
return $self->_testXenConfig();
|
||||
}
|
||||
|
||||
=begin doc
|
||||
|
||||
Test that the current Xen host has a valid network configuration,
|
||||
this is designed to help newcomers to Xen.
|
||||
|
||||
=end doc
|
||||
|
||||
=cut
|
||||
|
||||
sub _testXenConfig {
|
||||
my $self = shift;
|
||||
# wierdness.
|
||||
return if ( ! -d "/etc/xen" );
|
||||
|
||||
#
|
||||
# Temporary hash.
|
||||
#
|
||||
my %cfg;
|
||||
|
||||
#
|
||||
# Read the configuration file.
|
||||
#
|
||||
open( my $config_fh, q{<}, '/etc/xen/xend-config.sxp' )
|
||||
or die "Failed to read /etc/xen/xend-config.sxp: $!";
|
||||
while( <$config_fh> )
|
||||
{
|
||||
next if ( ! $_ || !length( $_ ) );
|
||||
|
||||
# vif
|
||||
if ( $_ =~ /^\(vif-script ([^)]+)/ )
|
||||
{
|
||||
$cfg{'vif-script'} = $1;
|
||||
}
|
||||
|
||||
# network
|
||||
if ( $_ =~ /^\(network-script ([^)]+)/ )
|
||||
{
|
||||
$cfg{'network-script'} = $1;
|
||||
}
|
||||
}
|
||||
close( $config_fh );
|
||||
|
||||
if ( !defined( $cfg{'network-script'} ) ||
|
||||
!defined( $cfg{'vif-script'} ) )
|
||||
{
|
||||
print <<EOF;
|
||||
|
||||
WARNING
|
||||
-------
|
||||
|
||||
You appear to have a missing vif-script, or network-script, in the
|
||||
Xen configuration file /etc/xen/xend-config.sxp.
|
||||
|
||||
Please fix this and restart Xend, or your guests will not be able
|
||||
to use any networking!
|
||||
|
||||
EOF
|
||||
}
|
||||
else
|
||||
{
|
||||
if ( ( $cfg{'network-script'} =~ /dummy/i ) ||
|
||||
( $cfg{'vif-script'} =~ /dummy/i ) )
|
||||
{
|
||||
|
||||
print <<EOF;
|
||||
WARNING
|
||||
-------
|
||||
|
||||
You appear to have a "dummy" vif-script, or network-script, setting
|
||||
in the Xen configuration file /etc/xen/xend-config.sxp.
|
||||
|
||||
Please fix this and restart Xend, or your guests will not be able to
|
||||
use any networking!
|
||||
|
||||
EOF
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
C.J. Adams-Collier, C<< <cjac at colliertech.org> >>
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Please report any bugs or feature requests to C<bug-xen-tools at rt.cpan.org>, or through
|
||||
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Xen-Tools>. I will be notified, and then you'll
|
||||
automatically be notified of progress on your bug as I make changes.
|
||||
|
||||
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc Xen::Tools
|
||||
|
||||
|
||||
You can also look for information at:
|
||||
|
||||
=over 4
|
||||
|
||||
=item * RT: CPAN's request tracker
|
||||
|
||||
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Xen-Tools>
|
||||
|
||||
=item * AnnoCPAN: Annotated CPAN documentation
|
||||
|
||||
L<http://annocpan.org/dist/Xen-Tools>
|
||||
|
||||
=item * CPAN Ratings
|
||||
|
||||
L<http://cpanratings.perl.org/d/Xen-Tools>
|
||||
|
||||
=item * Search CPAN
|
||||
|
||||
L<http://search.cpan.org/dist/Xen-Tools>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT & LICENSE
|
||||
|
||||
Copyright 2007 C.J. Adams-Collier, all rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of Xen::Tools
|
||||
@@ -1,212 +0,0 @@
|
||||
package Xen::Tools::Log;
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
use Moose;
|
||||
use File::Spec;
|
||||
use POSIX; # strftime
|
||||
use Carp;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Xen::Tools::Log - Log Xen::Tools events
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Version 0.01
|
||||
|
||||
=cut
|
||||
|
||||
our $VERSION = '0.01';
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Mostly internal to Xen::Tools. Use this to create a logging mechanism.
|
||||
|
||||
my $xtl = Xen::Tools::Log->new( hostname => 'firewall' );
|
||||
|
||||
$xtl->print("Yay for logging.");
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
=head2 new
|
||||
|
||||
Create the log object
|
||||
|
||||
=cut
|
||||
|
||||
=head2 print
|
||||
|
||||
Print the given string both to our screen, and to the logfile.
|
||||
|
||||
=cut
|
||||
|
||||
sub print {
|
||||
my $self = shift;
|
||||
|
||||
$self->print_screen( @_ );
|
||||
$self->print_log( @_ );
|
||||
}
|
||||
|
||||
=head2 print_screen
|
||||
|
||||
Print the given string to our screen
|
||||
|
||||
=cut
|
||||
|
||||
sub print_screen {
|
||||
my $self = shift;
|
||||
|
||||
print map { "$_\n" } @_;
|
||||
}
|
||||
|
||||
=head2 print_log
|
||||
|
||||
Print the given string to the logfile.
|
||||
|
||||
=cut
|
||||
|
||||
sub print_log {
|
||||
my $self = shift;
|
||||
|
||||
# Create an RFC 822 conformant date string
|
||||
my $date = strftime( "%a, %d %b %Y %H:%M:%S %z", localtime );
|
||||
my $fh = $self->log_fh();
|
||||
print $fh ( map { "$date - $_" } @_ );
|
||||
}
|
||||
|
||||
=head2 hostname
|
||||
|
||||
Attribute storing the hostname this log describes
|
||||
|
||||
=cut
|
||||
|
||||
has 'hostname' => ( is => 'rw', isa => 'Str', required => 1 );
|
||||
|
||||
=head2 logpath
|
||||
|
||||
Attribute storing the directory in which the log file resides
|
||||
|
||||
=cut
|
||||
|
||||
has 'logpath' => ( is => 'rw',
|
||||
isa => 'Str',
|
||||
default => '/var/log/xen-tools'
|
||||
);
|
||||
|
||||
=head2 log_fh
|
||||
|
||||
FileHandle attribute storing the filehandle of the log
|
||||
|
||||
=cut
|
||||
|
||||
has 'log_fh' => ( is => 'ro',
|
||||
isa => 'FileHandle',
|
||||
lazy => 1,
|
||||
default => \&_init_fh,
|
||||
);
|
||||
|
||||
=head2 clean_up
|
||||
|
||||
Boolean attribute indicating whether the log will be cleaned up when the
|
||||
logger is closed
|
||||
|
||||
=cut
|
||||
|
||||
has 'clean_up' => ( is => 'ro',
|
||||
isa => 'Bool',
|
||||
default => 0,
|
||||
);
|
||||
|
||||
before 'DESTROY' => sub {
|
||||
my $self = shift;
|
||||
|
||||
# Deconstructor
|
||||
};
|
||||
|
||||
=head2 meta
|
||||
|
||||
This is a method which provides access to the current class's meta-
|
||||
class. Inherited from Moose.
|
||||
|
||||
=cut
|
||||
|
||||
=begin doc
|
||||
|
||||
_init_fh
|
||||
|
||||
This private method initializes the logging filehandle, creating the
|
||||
containing directory if it does not exist.
|
||||
|
||||
=end doc
|
||||
|
||||
=cut
|
||||
|
||||
sub _init_fh {
|
||||
my $self = shift;
|
||||
|
||||
my $logFile =
|
||||
File::Spec->catfile( $self->logpath(), $self->hostname() . '.log' );
|
||||
|
||||
system( qw(mkdir -p), $self->logpath() ) unless -d $self->logpath();
|
||||
|
||||
carp "Couldn't create log directory: $!" unless $? == 0;
|
||||
|
||||
open( $self->{log_fh}, q{>>}, $logFile ) or
|
||||
carp "Couldn't open log file for append: $!";
|
||||
};
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
C.J. Adams-Collier, C<< <cjac at colliertech.org> >>
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
Please report any bugs or feature requests to C<bug-xen-tools-log at rt.cpan.org>, or through
|
||||
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Xen-Tools>. I will be notified, and then you'll
|
||||
automatically be notified of progress on your bug as I make changes.
|
||||
|
||||
|
||||
|
||||
|
||||
=head1 SUPPORT
|
||||
|
||||
You can find documentation for this module with the perldoc command.
|
||||
|
||||
perldoc Xen::Tools
|
||||
|
||||
|
||||
You can also look for information at:
|
||||
|
||||
=over 4
|
||||
|
||||
=item * RT: CPAN's request tracker
|
||||
|
||||
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Xen-Tools>
|
||||
|
||||
=item * AnnoCPAN: Annotated CPAN documentation
|
||||
|
||||
L<http://annocpan.org/dist/Xen-Tools>
|
||||
|
||||
=item * CPAN Ratings
|
||||
|
||||
L<http://cpanratings.perl.org/d/Xen-Tools>
|
||||
|
||||
=item * Search CPAN
|
||||
|
||||
L<http://search.cpan.org/dist/Xen-Tools>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT & LICENSE
|
||||
|
||||
Copyright 2007 C.J. Adams-Collier, all rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
|
||||
=cut
|
||||
|
||||
1; # End of Xen::Tools::Log
|
||||
@@ -25,7 +25,7 @@ use Test::More qw( no_plan );
|
||||
EOF
|
||||
|
||||
|
||||
for i in `grep '^use ' -r .. | grep -v Expect | grep -v POSIX | grep -v Xen:: | grep -v Moose | awk '{print $2}' | tr -d
|
||||
for i in `grep '^use ' -r .. | grep -v Expect | grep -v POSIX | grep -v Xen:: | awk '{print $2}' | tr -d
|
||||
\;\(\) | sort | uniq`; \
|
||||
do \
|
||||
echo "BEGIN{ use_ok( '$i' ); }"; \
|
||||
|
||||
@@ -13,11 +13,6 @@ use strict;
|
||||
use File::Find;
|
||||
use Test::More;
|
||||
|
||||
eval "use Moose";
|
||||
plan skip_all => "Moose required for testing Perl syntax"
|
||||
if $@;
|
||||
|
||||
|
||||
#
|
||||
# Find all the files beneath the current directory,
|
||||
# and call 'checkFile' with the name.
|
||||
|
||||
@@ -1,15 +0,0 @@
|
||||
#!/usr/bin/perl -I../lib -I./lib
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 1, skip_all => 'Xen::Tools::Log is not used for now';
|
||||
use File::Temp;
|
||||
|
||||
use Xen::Tools::Log;
|
||||
|
||||
my $dir = File::Temp::tempdir( CLEANUP => 1 );
|
||||
|
||||
my $xtl = Xen::Tools::Log->new( hostname => 'xen-tools-log-test',
|
||||
logpath => $dir );
|
||||
|
||||
ok( $xtl->isa('Xen::Tools::Log') );
|
||||
@@ -1,23 +0,0 @@
|
||||
#!/usr/bin/perl -I../lib -I./lib
|
||||
#
|
||||
# Test we can load the (stub) Xen::Tools package.
|
||||
#
|
||||
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More skip_all => 'Xen::Tools is not used for now';
|
||||
|
||||
SKIP: {
|
||||
skip "Test only works as root", 1 if $< > 0;
|
||||
|
||||
eval {
|
||||
use Xen::Tools;
|
||||
|
||||
my $xt = Xen::Tools->new( hostname => 'xen-tools-test' );
|
||||
|
||||
ok( $xt->isa('Xen::Tools') );
|
||||
};
|
||||
}
|
||||
|
||||
done_testing();
|
||||
Reference in New Issue
Block a user