perl: Translate C examples into Perl and include a manual page.

This commit is contained in:
Richard W.M. Jones
2011-01-30 23:41:05 +00:00
parent 6975e87153
commit 477eebc83d
13 changed files with 253 additions and 31 deletions

3
.gitignore vendored
View File

@@ -109,6 +109,7 @@ html/guestfish.1.html
html/guestfs.3.html
html/guestfs-examples.3.html
html/guestfs-ocaml.3.html
html/guestfs-perl.3.html
html/guestfs-python.3.html
html/guestfs-ruby.3.html
html/guestmount.1.html
@@ -213,6 +214,8 @@ perl/blib
perl/Guestfs.bs
perl/Guestfs.c
perl/Guestfs.xs
perl/examples/guestfs-perl.3
perl/examples/stamp-guestfs-perl.pod
perl/lib/Sys/Guestfs.pm
perl/Makefile-pl
perl/Makefile-pl.old

View File

@@ -40,7 +40,7 @@ SUBDIRS += cat df inspector rescue
# Language bindings.
if HAVE_PERL
SUBDIRS += perl
SUBDIRS += perl perl/examples
endif
if HAVE_OCAML
SUBDIRS += ocaml ocaml/examples
@@ -109,6 +109,7 @@ HTMLFILES = \
html/guestfs.3.html \
html/guestfs-examples.3.html \
html/guestfs-ocaml.3.html \
html/guestfs-perl.3.html \
html/guestfs-python.3.html \
html/guestfs-ruby.3.html \
html/guestfish.1.html \

View File

@@ -793,7 +793,7 @@ AC_CONFIG_FILES([Makefile
regressions/Makefile
test-tool/Makefile
ocaml/Makefile ocaml/examples/Makefile
perl/Makefile
perl/Makefile perl/examples/Makefile
python/Makefile python/examples/Makefile
ruby/Makefile ruby/Rakefile ruby/examples/Makefile
java/Makefile

View File

@@ -34,6 +34,7 @@ libguestfs, you also need to read L<guestfs(3)>.
L<guestfs(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-perl(3)>,
L<guestfs-python(3)>,
L<guestfs-ruby(3)>,
L<http://libguestfs.org/>,

View File

@@ -79,6 +79,7 @@ function that you called.
L<guestfs(3)>,
L<guestfs-examples(3)>,
L<guestfs-perl(3)>,
L<guestfs-python(3)>,
L<guestfs-ruby(3)>,
L<http://libguestfs.org/>,

39
perl/examples/Makefile.am Normal file
View File

@@ -0,0 +1,39 @@
# libguestfs Perl examples
# Copyright (C) 2011 Red Hat Inc.
#
# This program 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 of the License, or
# (at your option) any later version.
#
# This program 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 program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
EXTRA_DIST = \
LICENSE \
create_disk.pl \
inspect_vm.pl \
guestfs-perl.pod
CLEANFILES = stamp-guestfs-perl.pod
man_MANS = guestfs-perl.3
noinst_DATA = $(top_builddir)/html/guestfs-perl.3.html
guestfs-perl.3 $(top_builddir)/html/guestfs-perl.3.html: stamp-guestfs-perl.pod
stamp-guestfs-perl.pod: guestfs-perl.pod create_disk.pl inspect_vm.pl
$(top_srcdir)/podwrapper.sh \
--section 3 \
--man guestfs-perl.3 \
--html $(top_builddir)/html/guestfs-perl.3.html \
--verbatim create_disk.pl:@EXAMPLE1@ \
--verbatim inspect_vm.pl:@EXAMPLE2@ \
$<
touch $@

67
perl/examples/create_disk.pl Executable file
View File

@@ -0,0 +1,67 @@
#!/usr/bin/perl -w
# Example showing how to create a disk image.
use strict;
use Sys::Guestfs;
my $output = "disk.img";
my $g = new Sys::Guestfs ();
# Create a raw-format sparse disk image, 512 MB in size.
open FILE, ">$output" or die "$output: $!";
truncate FILE, 512 * 1024 * 1024 or die "$output: truncate: $!";
close FILE or die "$output: $!";
# Set the trace flag so that we can see each libguestfs call.
$g->set_trace (1);
# Set the autosync flag so that the disk will be synchronized
# automatically when the libguestfs handle is closed.
$g->set_autosync (1);
# Attach the disk image to libguestfs.
$g->add_drive_opts ($output, format => "raw", readonly => 0);
# Run the libguestfs back-end.
$g->launch ();
# Get the list of devices. Because we only added one drive
# above, we expect that this list should contain a single
# element.
my @devices = $g->list_devices ();
if (@devices != 1) {
die "error: expected a single device from list-devices";
}
# Partition the disk as one single MBR partition.
$g->part_disk ($devices[0], "mbr");
# Get the list of partitions. We expect a single element, which
# is the partition we have just created.
my @partitions = $g->list_partitions ();
if (@partitions != 1) {
die "error: expected a single partition from list-partitions";
}
# Create a filesystem on the partition.
$g->mkfs ("ext4", $partitions[0]);
# Now mount the filesystem so that we can add files.
$g->mount_options ("", $partitions[0], "/");
# Create some files and directories.
$g->touch ("/empty");
my $message = "Hello, world\n";
$g->write ("/hello", $message);
$g->mkdir ("/foo");
# This one uploads the local file /etc/resolv.conf into
# the disk image.
$g->upload ("/etc/resolv.conf", "/foo/resolv.conf");
# Because 'autosync' was set (above) we can just exit here
# and the disk contents will be synchronized. You can also do
# this manually by calling $g->umount_all and $g->sync.
exit 0

View File

@@ -0,0 +1,72 @@
=encoding utf8
=head1 NAME
guestfs-perl - How to use libguestfs from Perl
=head1 SYNOPSIS
use Sys::Guestfs;
my $h = Sys::Guestfs->new ();
$h->add_drive_opts ('guest.img', format => 'raw');
$h->launch ();
$h->mount_options ('', '/dev/sda1', '/');
$h->touch ('/hello');
$h->sync ();
=head1 DESCRIPTION
This manual page documents how to call libguestfs from the Perl
programming language. This page just documents the differences from
the C API and gives some examples. If you are not familiar with using
libguestfs, you also need to read L<guestfs(3)>. To read the
full Perl API, see L<Sys::Guestfs(3)>.
=head2 ERRORS
Errors from libguestfs functions turn into calls to
C<croak> (see L<Carp(3)>).
=head1 EXAMPLE 1: CREATE A DISK IMAGE
@EXAMPLE1@
=head1 EXAMPLE 2: INSPECT A VIRTUAL MACHINE DISK IMAGE
@EXAMPLE2@
=head1 SEE ALSO
L<Sys::Guestfs(3)>,
L<guestfs(3)>,
L<guestfs-examples(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-python(3)>,
L<guestfs-ruby(3)>,
L<http://libguestfs.org/>.
=head1 AUTHORS
Richard W.M. Jones (C<rjones at redhat dot com>)
=head1 COPYRIGHT
Copyright (C) 2011 Red Hat Inc. L<http://libguestfs.org/>
The examples in this manual page may be freely copied, modified and
distributed without any restrictions.
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

64
perl/examples/inspect_vm.pl Executable file
View File

@@ -0,0 +1,64 @@
#!/usr/bin/perl -w
# Example showing how to inspect a virtual machine disk.
use strict;
use Sys::Guestfs;
if (@ARGV < 1) {
die "usage: inspect_vm disk.img"
}
my $disk = $ARGV[0];
my $g = new Sys::Guestfs ();
# Attach the disk image read-only to libguestfs.
# You could also add an optional format => ... argument here. This is
# advisable since automatic format detection is insecure.
$g->add_drive_opts ($disk, readonly => 1);
# Run the libguestfs back-end.
$g->launch ();
# Ask libguestfs to inspect for operating systems.
my @roots = $g->inspect_os ();
if (@roots == 0) {
die "inspect_vm: no operating systems found";
}
for my $root (@roots) {
printf "Root device: %s\n", $root;
# Print basic information about the operating system.
printf " Product name: %s\n", $g->inspect_get_product_name ($root);
printf " Version: %d.%d\n",
$g->inspect_get_major_version ($root),
$g->inspect_get_minor_version ($root);
printf " Type: %s\n", $g->inspect_get_type ($root);
printf " Distro: %s\n", $g->inspect_get_distro ($root);
# Mount up the disks, like guestfish -i.
#
# Sort keys by length, shortest first, so that we end up
# mounting the filesystems in the correct order.
my %mps = $g->inspect_get_mountpoints ($root);
my @mps = sort { length $a <=> length $b } (keys %mps);
for my $mp (@mps) {
eval { $g->mount_ro ($mps{$mp}, $mp) };
if ($@) {
print "$@ (ignored)\n"
}
}
# If /etc/issue.net file exists, print up to 3 lines.
my $filename = "/etc/issue.net";
if ($g->is_file ($filename)) {
printf "--- %s ---\n", $filename;
my @lines = $g->head_n (3, $filename);
print $_ foreach @lines;
}
# Unmount everything.
$g->umount_all ()
}

View File

@@ -1,28 +0,0 @@
#!/usr/bin/perl -w
use strict;
use Sys::Guestfs;
# Look for LVM LVs, VGs and PVs in a guest image.
die "Usage: lvs.pl guest.img\n" if @ARGV != 1 || ! -f $ARGV[0];
print "Creating the libguestfs handle\n";
my $h = Sys::Guestfs->new ();
$h->add_drive_opts ($ARGV[0], format => "raw");
print "Launching, this can take a few seconds\n";
$h->launch ();
print "Looking for PVs on the disk image\n";
my @pvs = $h->pvs ();
print "PVs found: (", join (", ", @pvs), ")\n";
print "Looking for VGs on the disk image\n";
my @vgs = $h->vgs ();
print "VGs found: (", join (", ", @vgs), ")\n";
print "Looking for LVs on the disk image\n";
my @lvs = $h->lvs ();
print "LVs found: (", join (", ", @lvs), ")\n";

View File

@@ -44,6 +44,7 @@ Type:
L<guestfs(3)>,
L<guestfs-examples(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-perl(3)>,
L<guestfs-ruby(3)>,
L<http://libguestfs.org/>.

View File

@@ -38,6 +38,7 @@ string).
L<guestfs(3)>,
L<guestfs-examples(3)>,
L<guestfs-ocaml(3)>,
L<guestfs-perl(3)>,
L<guestfs-python(3)>,
L<http://libguestfs.org/>.

View File

@@ -737,7 +737,7 @@ See L<guestfs-ocaml(3)>.
=item B<Perl>
See L<Sys::Guestfs(3)>.
See L<guestfs-perl(3)> and L<Sys::Guestfs(3)>.
=item B<PHP>