X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=perl%2Flib%2FSys%2FGuestfs%2FLib.pm;h=c97fae38105adbeea719de7180ab017e74e26c67;hb=6699491803962a5dee13997f1cc98f119d7101f4;hp=8ea2c1bf3e2f48748e7cdbdef2487c9d756efc8f;hpb=bf6ea125577dccdb18cab635eda1fb79cd98e0d5;p=libguestfs.git diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm index 8ea2c1b..c97fae3 100644 --- a/perl/lib/Sys/Guestfs/Lib.pm +++ b/perl/lib/Sys/Guestfs/Lib.pm @@ -64,7 +64,8 @@ require Exporter; use vars qw(@EXPORT_OK @ISA); @ISA = qw(Exporter); -@EXPORT_OK = qw(open_guest get_partitions resolve_windows_path +@EXPORT_OK = qw(open_guest feature_available + get_partitions resolve_windows_path inspect_all_partitions inspect_partition inspect_operating_systems mount_operating_system inspect_in_detail inspect_linux_kernel); @@ -208,6 +209,30 @@ sub open_guest return wantarray ? ($g, $conn, $dom, @images) : $g } +=head2 feature_available + + $bool = feature_available ($g, $feature [, $feature ...]); + +This function is a useful wrapper around the basic +C<$g-Eavailable> call. + +C<$g-Eavailable> tests for availability of a list of features and +dies with an error if any is not available. + +This call tests for the list of features and returns true if all are +available, or false otherwise. + +For a list of features you can test for, see L. + +=cut + +sub feature_available { + my $g = shift; + + eval { $g->available (\@_); }; + return $@ ? 0 : 1; +} + =head2 get_partitions @partitions = get_partitions ($g); @@ -230,7 +255,8 @@ sub get_partitions my @pvs = $g->pvs (); @partitions = grep { ! _is_pv ($_, @pvs) } @partitions; - my @lvs = $g->lvs (); + my @lvs; + @lvs = $g->lvs () if feature_available ($g, "lvm2"); return sort (@lvs, @partitions); } @@ -267,38 +293,12 @@ by C characters. Do not use C<\>, drive names, etc. sub resolve_windows_path { - local $_; my $g = shift; my $path = shift; - if (substr ($path, 0, 1) ne "/") { - warn __"resolve_windows_path: path must start with a / character"; - return undef; - } - - my @elems = split (/\//, $path); - shift @elems; - - # Start reconstructing the path at the top. - $path = "/"; - - foreach my $dir (@elems) { - my $found = 0; - foreach ($g->ls ($path)) { - if (lc ($_) eq lc ($dir)) { - if ($path eq "/") { - $path = "/$_"; - $found = 1; - } else { - $path = "$path/$_"; - $found = 1; - } - } - } - return undef unless $found; - } - - return $path; + my $r; + eval { $r = $g->case_sensitive_path ($path); }; + return $r; } =head2 file_architecture @@ -1504,7 +1504,7 @@ sub _check_for_kernels { my ($g, $os) = @_; - if ($os->{os} eq "linux") { + if ($os->{os} eq "linux" && feature_available ($g, "augeas")) { # Iterate over entries in grub.conf, populating $os->{boot} # For every kernel we find, inspect it and add to $os->{kernels}