[libvirt] [TCK PATCH] maint: remove duplicate file

Eric Blake eblake at redhat.com
Thu Apr 15 17:13:16 UTC 2010


File is a duplicate of 14f3792:lib/Sys/Virt/TCK.pm.  Besides, it
is already exluded by MANIFEST.SKIP.

* lib/Sys/Virt/TCK.pm.orig: Delete.
* .gitignore: Sort.  Add *.orig.
---
 .gitignore               |   25 +-
 lib/Sys/Virt/TCK.pm.orig |  766 ----------------------------------------------
 2 files changed, 13 insertions(+), 778 deletions(-)
 delete mode 100644 lib/Sys/Virt/TCK.pm.orig

diff --git a/.gitignore b/.gitignore
index 2c7ac91..cc1470e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,18 +1,19 @@
+#.*#
+*.bak
+*.orig
 *~
-pm_to_blib
+Build
+MANIFEST
+META.yml
 Makefile
+Makefile.PL
 Makefile.old
-#.*#
-blib/
 Sys-Virt-TCK-*
-MANIFEST
-*.bak
-results/
-data/
-META.yml
-cover_db/
 _build/
-perl-Sys-Virt-TCK.spec
-Build
-Makefile.PL
+blib/
+cover_db/
+data/
 libvirt-tck
+perl-Sys-Virt-TCK.spec
+pm_to_blib
+results/
diff --git a/lib/Sys/Virt/TCK.pm.orig b/lib/Sys/Virt/TCK.pm.orig
deleted file mode 100644
index 909ddd8..0000000
--- a/lib/Sys/Virt/TCK.pm.orig
+++ /dev/null
@@ -1,766 +0,0 @@
-
-package Sys::Virt::TCK;
-
-use strict;
-use warnings;
-
-use Sys::Virt;
-use Sys::Virt::TCK::DomainBuilder;
-use Sys::Virt::TCK::NetworkBuilder;
-use Sys::Virt::TCK::StoragePoolBuilder;
-use Sys::Virt::TCK::StorageVolBuilder;
-use Sys::Virt::TCK::Capabilities;
-
-use Config::Record;
-use File::Copy qw(copy);
-use File::Path qw(mkpath);
-use File::Spec::Functions qw(catfile catdir rootdir);
-use Cwd qw(cwd);
-use LWP::UserAgent;
-use IO::Uncompress::Gunzip qw(gunzip);
-use IO::Uncompress::Bunzip2 qw(bunzip2);
-use XML::XPath;
-use Carp qw(cluck carp);
-
-use Test::Builder;
-use Sub::Uplevel qw(uplevel);
-use base qw(Exporter);
-
-our @EXPORT = qw(ok_error ok_domain ok_pool ok_volume xpath err_not_implemented);
-
-our $VERSION = '0.1.0';
-
-sub new {
-    my $proto = shift;
-    my $class = ref($proto) || $proto;
-    my $self = {};
-    my %params = @_;
-
-    $self->{config} = $params{config} ? $params{config} :
-	Config::Record->new(file => ($ENV{LIBVIRT_TCK_CONFIG} || "/etc/tck.conf"));
-
-    $self->{autoclean} = $params{autoclean} ? $params{autoclean} :
-	($ENV{LIBVIRT_TCK_AUTOCLEAN} || 0);
-
-    if ($ENV{LIBVIRT_TCK_DEBUG}) {
-	$SIG{__WARN__} = sub { Carp::cluck $_[0]; };
-	$SIG{__DIE__} = sub { Carp::confess $_[0]; };
-    }
-
-    bless $self, $class;
-
-    return $self;
-}
-
-
-sub setup {
-    my $self = shift;
-
-    my $uri = $self->config("uri", undef);
-    $self->{conn} = Sys::Virt->new(address => $uri);
-    my $type = $self->{conn}->get_type();
-    $self->{type} = lc $type;
-
-    $self->reset if $self->{autoclean};
-
-    $self->sanity_check;
-
-    return $self->{conn};
-}
-
-
-sub sanity_check {
-    my $self = shift;
-
-    my @doms = grep { $_->get_name =~ /^tck/ } $self->{conn}->list_domains;
-    if (@doms) {
-	die "there is/are " . int(@doms) . " pre-existing active domain(s) in this driver";
-    }
-
-    @doms = grep { $_->get_name =~ /^tck/ } $self->{conn}->list_defined_domains;
-    if (@doms) {
-	die "there is/are " . int(@doms) . " pre-existing inactive domain(s) in this driver";
-    }
-
-    my @pools = grep { $_->get_name =~ /^tck/ } $self->{conn}->list_storage_pools;
-    if (@pools) {
-	die "there is/are " . int(@pools) . " pre-existing active storage_pool(s) in this driver";
-    }
-
-    @pools = grep { $_->get_name =~ /^tck/ } $self->{conn}->list_defined_storage_pools;
-    if (@pools) {
-	die "there is/are " . int(@pools) . " pre-existing inactive storage_pool(s) in this driver";
-    }
-}
-
-sub reset {
-    my $self = shift;
-
-    my @doms = grep { $_->get_name =~ /^tck/ } $self->{conn}->list_domains;
-    foreach my $dom (@doms) {
-	if ($dom->get_id != 0) {
-	    $dom->destroy;
-	}
-    }
-
-    @doms = grep { $_->get_name =~ /^tck/ } $self->{conn}->list_defined_domains();
-    foreach my $dom (@doms) {
-	$dom->undefine;
-    }
-
-    my @pools = grep { $_->get_name =~ /^tck/ } $self->{conn}->list_storage_pools;
-    foreach my $pool (@pools) {
-	my @vols = $pool->list_volumes;
-	foreach my $vol (@vols) {
-	    eval { $vol->delete(0) };
-	}
-	$pool->destroy;
-    }
-
-    @pools = grep { $_->get_name =~ /^tck/ } $self->{conn}->list_defined_storage_pools();
-    foreach my $pool (@pools) {
-	eval {
-	    $pool->delete(0);
-	};
-	$pool->undefine;
-    }
-}
-
-sub cleanup {
-    my $self = shift;
-
-    $self->reset();
-
-    delete $self->{conn};
-}
-
-sub config {
-    my $self = shift;
-    my $key = shift;
-    if (@_) {
-	my $default = shift;
-	return $self->{config}->get($key, $default);
-    } else {
-	return $self->{config}->get($key);
-    }
-}
-
-
-sub conn {
-    my $self = shift;
-    return $self->{conn};
-}
-
-
-sub scratch_dir {
-    my $self = shift;
-
-    my $scratch = $self->config("scratch_dir", $< > 0 ?
-				catdir(cwd(), "libvirt-tck") :
-				catdir(rootdir(), "var", "cache", "libvirt-tck"));
-
-    mkpath($scratch) unless -e $scratch;
-
-    return $scratch;
-}
-
-sub bucket_dir {
-    my $self = shift;
-    my $name = shift;
-
-    my $scratch = $self->scratch_dir;
-
-    my $bucket = catdir($scratch, $name);
-    mkpath($bucket) unless -e $bucket;
-
-    return $bucket;
-}
-
-sub get_scratch_resource {
-    my $self = shift;
-    my $source = shift;
-    my $bucket = shift;
-    my $name = shift;
-
-    my $dir = $self->bucket_dir($bucket);
-    my $target = catfile($dir, $name);
-
-    return $target if -e $target;
-
-    my $uncompress = undef;
-    if (ref($source)) {
-	$uncompress = $source->{uncompress};
-	$source = $source->{source};
-    }
-
-    if ($source =~ m,^/,) {
-	$self->copy_scratch($source, $target, $uncompress);
-    } else {
-	$self->download_scratch($source, $target, $uncompress);
-    }
-
-    return $target;
-}
-
-
-sub download_scratch {
-    my $self = shift;
-    my $source = shift;
-    my $target = shift;
-    my $uncompress = shift;
-
-    my $ua = LWP::UserAgent->new;
-    $ua->timeout(10);
-    $ua->env_proxy;
-
-    my $response = $ua->get($source);
-
-    if ($response->is_success) {
-	open TGT, ">$target" or die "cannot create $target: $!";
-	if (defined $uncompress) {
-	    my $data = $response->content;
-	    if ($uncompress eq "gzip") {
-		gunzip \$data => \*TGT;
-	    } elsif ($uncompress eq "bzip2") {
-		bunzip2 \$data => \*TGT;
-	    } else {
-		die "unknown compression method '$uncompress'";
-	    }
-	} else {
-	    print TGT $response->content or die "cannot write $target: $!";
-	}
-	close TGT or die "cannot save $target: $!";
-    } else {
-	die "cannot download $source: " . $response->status_line;
-    }
-
-}
-
-sub copy_scratch {
-    my $self = shift;
-    my $source = shift;
-    my $target = shift;
-    my $uncompress = shift;
-
-    if (defined $uncompress) {
-	if ($uncompress eq "gzip") {
-	    gunzip $source => $target;
-	} elsif ($uncompress eq "bzip2") {
-	    bunzip2 $source => $target;
-	} else {
-	    die "unknown compression method '$uncompress'";
-	}
-    } else {
-	copy ($source, $target) or die "cannot copy $source to $target: $!";
-    }
-}
-
-
-sub create_sparse_disk {
-    my $self = shift;
-    my $bucket = shift;
-    my $name = shift;
-    my $size = shift;
-
-    my $dir = $self->bucket_dir($bucket);
-
-    my $target = catfile($dir, $name);
-
-    open DISK, ">$target" or die "cannot create $target: $!";
-
-    truncate DISK, ($size * 1024 * 1024);
-
-    close DISK or die "cannot save $target: $!";
-
-    return $target;
-}
-
-
-sub create_minimal_vroot {
-    my $self = shift;
-    my $bucket = shift;
-    my $name = shift;
-
-    my $dir = $self->bucket_dir($bucket);
-    my $target = catdir($dir, $name);
-
-    mkpath($target) unless -e $target;
-
-    my $busybox = $self->config("busybox", "/sbin/busybox");
-
-    die "$busybox does not exist" unless $busybox;
-
-    my $type = `file $busybox 2>&1`;
-
-    die "$busybox is not statically linked" unless $type =~ /statically/;
-
-    my @dirs = qw(sbin bin dev proc sys tmp);
-
-    foreach my $dir (@dirs) {
-	my $fulldir = catdir($target, $dir);
-	next if -e $fulldir;
-	mkpath($fulldir);
-    }
-
-    my $dst = catfile($target, "sbin", "busybox");
-    copy ($busybox, $dst) or die "cannot copy $busybox to $dst: $!";
-    chmod 0755, $dst or die "cannot make $dst executable: $!";
-
-    my @links = qw(
-            ed           kill        ping6              svlogd
-            egrep        killall     pipe_progress      swapoff
-addgroup    eject        killall5    pivot_root         swapon
-adduser     env          klogd       pkill              switch_root
-adjtimex    envdir       last        poweroff           sync
-ar          envuidgid    length      printenv           sysctl
-arp         expand       less        printf             syslogd
-arping      expr         linux32     ps                 tail
-ash         fakeidentd   linux64     pscan              tar
-awk         false        linuxrc     pwd                tcpsvd
-basename    fbset        ln          raidautorun        tee
-bunzip2     fdformat     loadfont    rdate              telnet
-busybox     fdisk        loadkmap    readahead          telnetd
-bzcat       fgrep        logger      readlink           test
-bzip2       find         login       readprofile        tftp
-cal         fold         logname     realpath           time
-cat         free         logread     reboot             top
-catv        freeramdisk  losetup     renice             touch
-chattr      fsck         ls          reset              tr
-chgrp       fsck.minix   lsattr      resize             traceroute
-chmod       ftpget       lsmod       rm                 true
-chown       ftpput       lzmacat     rmdir              tty
-chpasswd    fuser        makedevs    rmmod              ttysize
-chpst       getopt       md5sum      route              udhcpc
-chroot      getty        mdev        rpm                udhcpd
-chrt        grep         mesg        rpm2cpio           udpsvd
-chvt        gunzip       microcom    runlevel           umount
-cksum       gzip         mkdir       run-parts          uname
-clear       halt         mkfifo      runsv              uncompress
-cmp         hdparm       mkfs.minix  runsvdir           unexpand
-comm        head         mknod       rx                 uniq
-cp          hexdump      mkswap      sed                unix2dos
-cpio        hostid       mktemp      seq                unlzma
-crond       hostname     modprobe    setarch            unzip
-crontab     httpd        more        setconsole         uptime
-cryptpw     hwclock      mount       setkeycodes        usleep
-cut         id           mountpoint  setlogcons         uudecode
-date        ifconfig     msh         setsid             uuencode
-dc          ifdown       mt          setuidgid          vconfig
-dd          ifup         mv          sh                 vi
-deallocvt   inetd        nameif      sha1sum            vlock
-delgroup    init         nc          slattach           watch
-deluser     insmod       netstat     sleep              watchdog
-df          install      nice        softlimit          wc
-dhcprelay   ip           nmeter      sort               wget
-diff        ipaddr       nohup       split              which
-dirname     ipcalc       nslookup    start-stop-daemon  who
-dmesg       ipcrm        od          stat               whoami
-dnsd        ipcs         openvt      strings            xargs
-dos2unix    iplink       passwd      stty               yes
-du          iproute      patch       su                 zcat
-dumpkmap    iprule       pgrep       sulogin            zcip
-dumpleases  iptunnel     pidof       sum
-echo        kbd_mode     ping        sv);
-
-    foreach my $file (@links) {
-	my $fullfile = catfile($target, "bin", $file);
-	next if -e $fullfile;
-	symlink "../sbin/busybox", $fullfile
-	    or die "cannot symlink $fullfile to ../sbin/busybox: $!";
-    }
-
-    my $init = catfile($target, "sbin", "init");
-    open INIT, ">$init" or die "cannot create $init: $!";
-
-    print INIT <<EOF;
-#!/sbin/busybox
-
-sh
-EOF
-
-    close INIT or die "cannot save $init: $!";
-    chmod 0755, $init or die "cannot make $init executable: $!";
-
-    return ($target, catfile(rootdir, "sbin", "init"));
-}
-
-sub match_kernel {
-    my $self = shift;
-    my $caps = shift;
-    my $arch = shift;
-    my $ostype = shift;
-
-    for (my $i = 0 ; $i < $caps->num_guests ; $i++) {
-	if ($caps->guest_os_type($i) eq $ostype &&
-	    $caps->guest_arch_name($i) eq $arch) {
-
-	    my @domains = $caps->guest_domain_types($i);
-	    next unless int(@domains);
-
-	    return ($domains[0],
-		    $caps->guest_domain_emulator($i, $domains[0]),
-		    $caps->guest_domain_loader($i, $domains[0]));
-	}
-    }
-
-    return ();
-}
-
-
-sub best_kernel {
-    my $self = shift;
-    my $caps = shift;
-
-    my $kernels = $self->config("kernels", []);
-
-    for (my $i = 0 ; $i <= $#{$kernels} ; $i++) {
-	my $arch = $kernels->[$i]->{arch};
-	my $ostype = $kernels->[$i]->{ostype};
-	my @ostype = ref($ostype) ? @{$ostype} : ($ostype);
-
-	foreach $ostype (@ostype) {
-	    my ($domain, $emulator, $loader) =
-		$self->match_kernel($caps, $arch, $ostype);
-
-	    if (defined $domain) {
-		return ($i, $domain, $arch, $ostype, $emulator, $loader)
-	    }
-	}
-    }
-
-    return ();
-}
-
-sub get_kernel {
-    my $self = shift;
-    my $caps = shift;
-
-    my ($cfgindex, $domain, $arch, $ostype, $emulator, $loader) =
-	$self->best_kernel($caps);
-
-    if (!defined $cfgindex) {
-	die "cannot find any supported kernel configuration";
-    }
-
-    my $kernels = $self->config("kernels", []);
-
-    my $kernel = $kernels->[$cfgindex]->{kernel};
-    my $initrd = $kernels->[$cfgindex]->{initrd};
-    my $disk = $kernels->[$cfgindex]->{disk};
-
-    my $bucket = "os-$arch-$ostype";
-
-    my $kfile = $self->get_scratch_resource($kernel, $bucket, "vmlinuz");
-    my $ifile = $initrd ? $self->get_scratch_resource($initrd, $bucket, "initrd") : undef;
-    my $dfile = $disk ? $self->get_scratch_resource($disk, $bucket, "disk.img") : undef;
-
-    unless (defined $dfile) {
-	$dfile = $self->create_sparse_disk($bucket, "disk.img", 100);
-    }
-
-    chmod 0755, $kfile;
-
-    my $dev;
-    if ($ostype eq "xen") {
-	$dev = "xvda";
-    } elsif ($ostype eq "uml") {
-	$dev = "ubda";
-    } elsif ($ostype eq "hvm") {
-	if ($domain eq "kvm" ||
-	    $domain eq "qemu" ||
-	    $domain eq "kqemu") {
-	    $dev = "vda";
-	} else {
-	    $dev = "hda";
-	}
-    }
-
-    return (
-	domain => $domain,
-	arch => $arch,
-	ostype => $ostype,
-	emulator => $emulator,
-	loader => $loader,
-	kernel => $kfile,
-	initrd => $ifile,
-	root => $dfile,
-	dev => $dev,
-    );
-}
-
-
-
-sub generic_machine_domain {
-    my $self = shift;
-    my $name = shift;
-    my $caps = shift;
-
-    my %config = $self->get_kernel($caps);
-
-    my $b = Sys::Virt::TCK::DomainBuilder->new(conn => $self->{conn},
-					       name => $name,
-					       domain => $config{domain},
-					       ostype => $config{ostype});
-    $b->memory(64 * 1024);
-    $b->with_acpi();
-    $b->with_apic();
-
-    # XXX boot CDROM or vroot for other HVs
-    $b->boot_kernel($config{kernel}, $config{initrd});
-
-    $b->disk(src => $config{root},
-	     dst => $config{dev},
-	     type => "file");
-
-    return $b;
-}
-
-
-sub best_container_domain {
-    my $self = shift;
-    my $caps = shift;
-
-    for (my $i = 0 ; $i < $caps->num_guests ; $i++) {
-	if ($caps->guest_os_type($i) eq "exe") {
-	    my @domains = $caps->guest_domain_types($i);
-	    next unless int(@domains);
-
-	    return $domains[0];
-	}
-    }
-
-    return undef;
-
-}
-
-sub generic_container_domain {
-    my $self = shift;
-    my $name = shift;
-    my $caps = shift;
-    my $domain = shift;
-
-    my $bucket = "os-exe";
-
-    my $b = Sys::Virt::TCK::DomainBuilder->new(conn => $self->{conn},
-					       name => $name,
-					       domain => $domain,
-					       ostype => "exe");
-    $b->memory(64 * 1024);
-
-    my ($root, $init) = $self->create_minimal_vroot($bucket, $name);
-
-    $b->boot_init($init);
-
-    $b->filesystem(src => $root,
-		   dst => "/",
-		   type => "mount");
-
-    return $b;
-}
-
-
-sub generic_domain {
-    my $self = shift;
-    my $name = @_ ? shift : "tck";
-
-    my $caps = Sys::Virt::TCK::Capabilities->new(xml => $self->conn->get_capabilities);
-
-    my $container = $self->best_container_domain($caps);
-
-    if ($container) {
-	return $self->generic_container_domain($name, $caps, $container);
-    } else {
-	return $self->generic_machine_domain($name, $caps);
-    }
-}
-
-sub generic_pool {
-    my $self = shift;
-    my $type = shift;
-    my $name = @_ ? shift : "tck";
-
-    my $bucket = $self->bucket_dir("storage-fs");
-
-    my $b = Sys::Virt::TCK::StoragePoolBuilder->new(name => $name,
-						    type => $type);
-
-    $b->target(catdir($bucket, $name));
-
-    return $b;
-}
-
-
-sub generic_volume {
-    my $self = shift;
-    my $name = @_ ? shift : "tck";
-    my $format = @_ ? shift :undef;
-    my $capacity = @_ ? shift : 1024*1024*50;
-
-    my $b = Sys::Virt::TCK::StorageVolBuilder->new(name => $name);
-    $b->format($format) if $format;
-    $b->capacity($capacity);
-
-    return $b;
-}
-
-# Borrowed from Test::Exception
-
-sub _quiet_caller (;$) { ## no critic Prototypes
-    my $height = $_[0];
-    $height++;
-    if( wantarray and !@_ ) {
-        return (CORE::caller($height))[0..2];
-    }
-    else {
-        return CORE::caller($height);
-    }
-		   }
-
-sub _try_as_caller {
-    my $coderef = shift;
-
-    # local works here because Sub::Uplevel has already overridden caller
-    local *CORE::GLOBAL::caller;
-    { no warnings 'redefine'; *CORE::GLOBAL::caller = \&_quiet_caller; }
-
-    my $ret = eval { uplevel 3, $coderef };
-    return ($ret, $@);
-};
-
-
-my $Tester = Test::Builder->new;
-
-sub ok_domain(&$;$) {
-    my $coderef = shift;
-    my $description = shift;
-    my $name = shift;
-
-    die "must pass coderef, description and (optional) expected name"
-	unless defined $description;
-
-    my ($ret, $exception) = _try_as_caller($coderef);
-
-    my $ok = "$exception" eq "" &&
-	$ret && ref($ret) && $ret->isa("Sys::Virt::Domain") &&
-	(!defined $name || ($ret->get_name() eq $name));
-
-    $Tester->ok($ok, $description);
-    unless ($ok) {
-	$Tester->diag("expected Sys::Virt::Domain object" . ($name ? " with name $name" : ""));
-	if ($exception) {
-	    $Tester->diag("found '$exception'");
-	} else {
-	    if ($ret && ref($ret) && $ret->isa("Sys::Virt::Domain")) {
-		$Tester->diag("found Sys::Virt::Domain object with name " . $ret->get_name);
-	    } else {
-		$Tester->diag("found '$ret'");
-	    }
-	}
-    }
-}
-
-sub ok_pool(&$;$) {
-    my $coderef = shift;
-    my $description = shift;
-    my $name = shift;
-
-    die "must pass coderef, description and (optional) expected name"
-	unless defined $description;
-
-    my ($ret, $exception) = _try_as_caller($coderef);
-
-    my $ok = "$exception" eq "" &&
-	$ret && ref($ret) && $ret->isa("Sys::Virt::StoragePool") &&
-	(!defined $name || ($ret->get_name() eq $name));
-
-    $Tester->ok($ok, $description);
-    unless ($ok) {
-	$Tester->diag("expected Sys::Virt::StoragePool object" . ($name ? " with name $name" : ""));
-	if ($exception) {
-	    $Tester->diag("found '$exception'");
-	} else {
-	    if ($ret && ref($ret) && $ret->isa("Sys::Virt::StoragePool")) {
-		$Tester->diag("found Sys::Virt::StoragePool object with name " . $ret->get_name);
-	    } else {
-		$Tester->diag("found '$ret'");
-	    }
-	}
-    }
-}
-
-sub ok_volume(&$;$) {
-    my $coderef = shift;
-    my $description = shift;
-    my $name = shift;
-
-    die "must pass coderef, description and (optional) expected name"
-	unless defined $description;
-
-    my ($ret, $exception) = _try_as_caller($coderef);
-
-    my $ok = "$exception" eq "" &&
-	$ret && ref($ret) && $ret->isa("Sys::Virt::StorageVol") &&
-	(!defined $name || ($ret->get_name() eq $name));
-
-    $Tester->ok($ok, $description);
-    unless ($ok) {
-	$Tester->diag("expected Sys::Virt::StorageVol object" . ($name ? " with name $name" : ""));
-	if ($exception) {
-	    $Tester->diag("found '$exception'");
-	} else {
-	    if ($ret && ref($ret) && $ret->isa("Sys::Virt::StorageVol")) {
-		$Tester->diag("found Sys::Virt::StorageVol object with name " . $ret->get_name);
-	    } else {
-		$Tester->diag("found '$ret'");
-	    }
-	}
-    }
-}
-
-sub ok_error(&$;$) {
-    my $coderef = shift;
-    my $description = shift;
-    my $code = shift;
-
-    die "must pass coderef, description and (optional) expected error code"
-	unless defined $description;
-
-    my ($ret, $exception) = _try_as_caller($coderef);
-
-    my $ok = ref($exception) && $exception->isa("Sys::Virt::Error") &&
-	(!defined $code || ($exception->code() == $code));
-
-    $Tester->ok($ok, $description);
-    unless ($ok) {
-	$Tester->diag("expecting Sys::Virt::Error object" . ($code ?  " with code $code" : ""));
-	$Tester->diag("found '$exception'");
-    }
-    $@ = $exception;
-    return $ok;
-}
-
-
-sub err_not_implemented {
-    my $exception = shift;
-
-    if ($exception &&
-	ref($exception) &&
-	$exception->isa("Sys::Virt::Error") &&
-	$exception->code() == 3) {
-	return 1;
-    }
-    return 0;
-}
-
-sub xpath {
-    my $object = shift;
-    my $path = shift;
-
-    my $xml = $object->get_xml_description;
-
-    my $xp = XML::XPath->new(xml => $xml);
-
-    return $xp->find($path);
-}
-
-1;
-- 
1.6.6.1




More information about the libvir-list mailing list