perl: Translate C examples into Perl and include a manual page.
authorRichard W.M. Jones <rjones@redhat.com>
Sun, 30 Jan 2011 23:41:05 +0000 (23:41 +0000)
committerRichard W.M. Jones <rjones@redhat.com>
Sun, 30 Jan 2011 23:41:05 +0000 (23:41 +0000)
13 files changed:
.gitignore
Makefile.am
configure.ac
examples/guestfs-examples.pod
ocaml/examples/guestfs-ocaml.pod
perl/examples/Makefile.am [new file with mode: 0644]
perl/examples/create_disk.pl [new file with mode: 0755]
perl/examples/guestfs-perl.pod [new file with mode: 0644]
perl/examples/inspect_vm.pl [new file with mode: 0755]
perl/examples/lvs.pl [deleted file]
python/examples/guestfs-python.pod
ruby/examples/guestfs-ruby.pod
src/guestfs.pod

index 46d5af7..438e126 100644 (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
index d2c90fc..d6b4077 100644 (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 \
index a5d704a..576f399 100644 (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
index 787a370..f4c82a7 100644 (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/>,
index 21c4a70..6ea46f2 100644 (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/>,
diff --git a/perl/examples/Makefile.am b/perl/examples/Makefile.am
new file mode 100644 (file)
index 0000000..354531a
--- /dev/null
@@ -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 $@
diff --git a/perl/examples/create_disk.pl b/perl/examples/create_disk.pl
new file mode 100755 (executable)
index 0000000..5a81663
--- /dev/null
@@ -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
diff --git a/perl/examples/guestfs-perl.pod b/perl/examples/guestfs-perl.pod
new file mode 100644 (file)
index 0000000..4840890
--- /dev/null
@@ -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
diff --git a/perl/examples/inspect_vm.pl b/perl/examples/inspect_vm.pl
new file mode 100755 (executable)
index 0000000..447c889
--- /dev/null
@@ -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 ()
+}
diff --git a/perl/examples/lvs.pl b/perl/examples/lvs.pl
deleted file mode 100755 (executable)
index 1755c89..0000000
+++ /dev/null
@@ -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";
index 9cf7809..032d784 100644 (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/>.
 
index d3ce928..f09016a 100644 (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/>.
 
index b8b8ca2..cfd58c9 100644 (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>