diff options
author | Richard Jones <rjones@trick.home.annexia.org> | 2009-07-09 15:29:28 +0100 |
---|---|---|
committer | Richard Jones <rjones@trick.home.annexia.org> | 2009-07-09 15:34:52 +0100 |
commit | 64c565dc905cef89a681c0bd9dce0864f3b03797 (patch) | |
tree | d1d14abc6d19b39277b69f835ef8efe268e477fa /perl | |
parent | 7058e5c63ecc8ed41c9fcc011fbe215bad6f6369 (diff) | |
download | libguestfs-64c565dc905cef89a681c0bd9dce0864f3b03797.tar.gz libguestfs-64c565dc905cef89a681c0bd9dce0864f3b03797.tar.xz libguestfs-64c565dc905cef89a681c0bd9dce0864f3b03797.zip |
Move 'resolve_windows_path' to Sys::Guestfs::Lib.
Diffstat (limited to 'perl')
-rw-r--r-- | perl/lib/Sys/Guestfs/Lib.pm | 58 |
1 files changed, 57 insertions, 1 deletions
diff --git a/perl/lib/Sys/Guestfs/Lib.pm b/perl/lib/Sys/Guestfs/Lib.pm index 75b20565..e54b2440 100644 --- a/perl/lib/Sys/Guestfs/Lib.pm +++ b/perl/lib/Sys/Guestfs/Lib.pm @@ -58,7 +58,7 @@ require Exporter; use vars qw(@EXPORT_OK @ISA); @ISA = qw(Exporter); -@EXPORT_OK = qw(open_guest get_partitions); +@EXPORT_OK = qw(open_guest get_partitions resolve_windows_path); =head2 open_guest @@ -219,6 +219,62 @@ sub is_pv { 0; } +=head2 resolve_windows_path + + $path = resolve_windows_path ($g, $path); + + $path = resolve_windows_path ($g, "/windows/system"); + ==> "/WINDOWS/System" + or undef if no path exists + +This function, which is specific to FAT/NTFS filesystems (ie. Windows +guests), lets you look up a case insensitive C<$path> in the +filesystem and returns the true, case sensitive path as required by +the underlying kernel or NTFS-3g driver. + +If C<$path> does not exist then this function returns C<undef>. + +The C<$path> parameter must begin with C</> character and be separated +by C</> characters. Do not use C<\>, drive names, etc. + +=cut + +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; +} + 1; =head1 COPYRIGHT |