generator/generator_perl.ml

   1 (* libguestfs
   2  * Copyright (C) 2009-2010 Red Hat Inc.
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  17  *)
  18
  19 (* Please read generator/README first. *)
  20
  21 open Printf
  22
  23 open Generator_types
  24 open Generator_utils
  25 open Generator_pr
  26 open Generator_docstrings
  27 open Generator_optgroups
  28 open Generator_actions
  29 open Generator_structs
  30 open Generator_c
  31
  32 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
  33 let rec generate_perl_xs () =
  34   generate_header CStyle LGPLv2plus;
  35
  36   pr "\
  37 #include \"EXTERN.h\"
  38 #include \"perl.h\"
  39 #include \"XSUB.h\"
  40
  41 #include <guestfs.h>
  42
  43 #ifndef PRId64
  44 #define PRId64 \"lld\"
  45 #endif
  46
  47 static SV *
  48 my_newSVll(long long val) {
  49 #ifdef USE_64_BIT_ALL
  50   return newSViv(val);
  51 #else
  52   char buf[100];
  53   int len;
  54   len = snprintf(buf, 100, \"%%\" PRId64, val);
  55   return newSVpv(buf, len);
  56 #endif
  57 }
  58
  59 #ifndef PRIu64
  60 #define PRIu64 \"llu\"
  61 #endif
  62
  63 static SV *
  64 my_newSVull(unsigned long long val) {
  65 #ifdef USE_64_BIT_ALL
  66   return newSVuv(val);
  67 #else
  68   char buf[100];
  69   int len;
  70   len = snprintf(buf, 100, \"%%\" PRIu64, val);
  71   return newSVpv(buf, len);
  72 #endif
  73 }
  74
  75 /* http://www.perlmonks.org/?node_id=680842 */
  76 static char **
  77 XS_unpack_charPtrPtr (SV *arg) {
  78   char **ret;
  79   AV *av;
  80   I32 i;
  81
  82   if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
  83     croak (\"array reference expected\");
  84
  85   av = (AV *)SvRV (arg);
  86   ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
  87   if (!ret)
  88     croak (\"malloc failed\");
  89
  90   for (i = 0; i <= av_len (av); i++) {
  91     SV **elem = av_fetch (av, i, 0);
  92
  93     if (!elem || !*elem)
  94       croak (\"missing element in list\");
  95
  96     ret[i] = SvPV_nolen (*elem);
  97   }
  98
  99   ret[i] = NULL;
 100
 101   return ret;
 102 }
 103
 104 #define PROGRESS_KEY \"_perl_progress_cb\"
 105
 106 static void
 107 _clear_progress_callback (guestfs_h *g)
 108 {
 109   guestfs_set_progress_callback (g, NULL, NULL);
 110   SV *cb = guestfs_get_private (g, PROGRESS_KEY);
 111   if (cb) {
 112     guestfs_set_private (g, PROGRESS_KEY, NULL);
 113     SvREFCNT_dec (cb);
 114   }
 115 }
 116
 117 /* http://www.perlmonks.org/?node=338857 */
 118 static void
 119 _progress_callback (guestfs_h *g, void *cb,
 120                     int proc_nr, int serial, uint64_t position, uint64_t total)
 121 {
 122   dSP;
 123   ENTER;
 124   SAVETMPS;
 125   PUSHMARK (SP);
 126   XPUSHs (sv_2mortal (newSViv (proc_nr)));
 127   XPUSHs (sv_2mortal (newSViv (serial)));
 128   XPUSHs (sv_2mortal (my_newSVull (position)));
 129   XPUSHs (sv_2mortal (my_newSVull (total)));
 130   PUTBACK;
 131   call_sv ((SV *) cb, G_VOID | G_DISCARD | G_EVAL);
 132   FREETMPS;
 133   LEAVE;
 134 }
 135
 136 static void
 137 _close_handle (guestfs_h *g)
 138 {
 139   assert (g != NULL);
 140   _clear_progress_callback (g);
 141   guestfs_close (g);
 142 }
 143
 144 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
 145
 146 PROTOTYPES: ENABLE
 147
 148 guestfs_h *
 149 _create ()
 150    CODE:
 151       RETVAL = guestfs_create ();
 152       if (!RETVAL)
 153         croak (\"could not create guestfs handle\");
 154       guestfs_set_error_handler (RETVAL, NULL, NULL);
 155  OUTPUT:
 156       RETVAL
 157
 158 void
 159 DESTROY (sv)
 160       SV *sv;
 161  PPCODE:
 162       /* For the 'g' argument above we do the conversion explicitly and
 163        * don't rely on the typemap, because if the handle has been
 164        * explicitly closed we don't want the typemap conversion to
 165        * display an error.
 166        */
 167       HV *hv = (HV *) SvRV (sv);
 168       SV **svp = hv_fetch (hv, \"_g\", 2, 0);
 169       if (svp != NULL) {
 170         guestfs_h *g = (guestfs_h *) SvIV (*svp);
 171         _close_handle (g);
 172       }
 173
 174 void
 175 close (g)
 176       guestfs_h *g;
 177  PPCODE:
 178       _close_handle (g);
 179       /* Avoid double-free in DESTROY method. */
 180       HV *hv = (HV *) SvRV (ST(0));
 181       (void) hv_delete (hv, \"_g\", 2, G_DISCARD);
 182
 183 void
 184 set_progress_callback (g, cb)
 185       guestfs_h *g;
 186       SV *cb;
 187  PPCODE:
 188       _clear_progress_callback (g);
 189       SvREFCNT_inc (cb);
 190       guestfs_set_private (g, PROGRESS_KEY, cb);
 191       guestfs_set_progress_callback (g, _progress_callback, cb);
 192
 193 void
 194 clear_progress_callback (g)
 195       guestfs_h *g;
 196  PPCODE:
 197       _clear_progress_callback (g);
 198
 199 ";
 200
 201   List.iter (
 202     fun (name, style, _, _, _, _, _) ->
 203       (match fst style with
 204        | RErr -> pr "void\n"
 205        | RInt _ -> pr "SV *\n"
 206        | RInt64 _ -> pr "SV *\n"
 207        | RBool _ -> pr "SV *\n"
 208        | RConstString _ -> pr "SV *\n"
 209        | RConstOptString _ -> pr "SV *\n"
 210        | RString _ -> pr "SV *\n"
 211        | RBufferOut _ -> pr "SV *\n"
 212        | RStringList _
 213        | RStruct _ | RStructList _
 214        | RHashtable _ ->
 215            pr "void\n" (* all lists returned implictly on the stack *)
 216       );
 217       (* Call and arguments. *)
 218       pr "%s (g" name;
 219       List.iter (
 220         fun arg -> pr ", %s" (name_of_argt arg)
 221       ) (snd style);
 222       pr ")\n";
 223       pr "      guestfs_h *g;\n";
 224       iteri (
 225         fun i ->
 226           function
 227           | Pathname n | Device n | Dev_or_Path n | String n
 228           | FileIn n | FileOut n | Key n ->
 229               pr "      char *%s;\n" n
 230           | BufferIn n ->
 231               pr "      char *%s;\n" n;
 232               pr "      size_t %s_size = SvCUR (ST(%d));\n" n (i+1)
 233           | OptString n ->
 234               (* http://www.perlmonks.org/?node_id=554277
 235                * Note that the implicit handle argument means we have
 236                * to add 1 to the ST(x) operator.
 237                *)
 238               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
 239           | StringList n | DeviceList n -> pr "      char **%s;\n" n
 240           | Bool n -> pr "      int %s;\n" n
 241           | Int n -> pr "      int %s;\n" n
 242           | Int64 n -> pr "      int64_t %s;\n" n
 243       ) (snd style);
 244
 245       let do_cleanups () =
 246         List.iter (
 247           function
 248           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
 249           | Bool _ | Int _ | Int64 _
 250           | FileIn _ | FileOut _
 251           | BufferIn _ | Key _ -> ()
 252           | StringList n | DeviceList n -> pr "      free (%s);\n" n
 253         ) (snd style)
 254       in
 255
 256       (* Code. *)
 257       (match fst style with
 258        | RErr ->
 259            pr "PREINIT:\n";
 260            pr "      int r;\n";
 261            pr " PPCODE:\n";
 262            pr "      r = guestfs_%s " name;
 263            generate_c_call_args ~handle:"g" style;
 264            pr ";\n";
 265            do_cleanups ();
 266            pr "      if (r == -1)\n";
 267            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 268        | RInt n
 269        | RBool n ->
 270            pr "PREINIT:\n";
 271            pr "      int %s;\n" n;
 272            pr "   CODE:\n";
 273            pr "      %s = guestfs_%s " n name;
 274            generate_c_call_args ~handle:"g" style;
 275            pr ";\n";
 276            do_cleanups ();
 277            pr "      if (%s == -1)\n" n;
 278            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 279            pr "      RETVAL = newSViv (%s);\n" n;
 280            pr " OUTPUT:\n";
 281            pr "      RETVAL\n"
 282        | RInt64 n ->
 283            pr "PREINIT:\n";
 284            pr "      int64_t %s;\n" n;
 285            pr "   CODE:\n";
 286            pr "      %s = guestfs_%s " n name;
 287            generate_c_call_args ~handle:"g" style;
 288            pr ";\n";
 289            do_cleanups ();
 290            pr "      if (%s == -1)\n" n;
 291            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 292            pr "      RETVAL = my_newSVll (%s);\n" n;
 293            pr " OUTPUT:\n";
 294            pr "      RETVAL\n"
 295        | RConstString n ->
 296            pr "PREINIT:\n";
 297            pr "      const char *%s;\n" n;
 298            pr "   CODE:\n";
 299            pr "      %s = guestfs_%s " n name;
 300            generate_c_call_args ~handle:"g" style;
 301            pr ";\n";
 302            do_cleanups ();
 303            pr "      if (%s == NULL)\n" n;
 304            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 305            pr "      RETVAL = newSVpv (%s, 0);\n" n;
 306            pr " OUTPUT:\n";
 307            pr "      RETVAL\n"
 308        | RConstOptString n ->
 309            pr "PREINIT:\n";
 310            pr "      const char *%s;\n" n;
 311            pr "   CODE:\n";
 312            pr "      %s = guestfs_%s " n name;
 313            generate_c_call_args ~handle:"g" style;
 314            pr ";\n";
 315            do_cleanups ();
 316            pr "      if (%s == NULL)\n" n;
 317            pr "        RETVAL = &PL_sv_undef;\n";
 318            pr "      else\n";
 319            pr "        RETVAL = newSVpv (%s, 0);\n" n;
 320            pr " OUTPUT:\n";
 321            pr "      RETVAL\n"
 322        | RString n ->
 323            pr "PREINIT:\n";
 324            pr "      char *%s;\n" n;
 325            pr "   CODE:\n";
 326            pr "      %s = guestfs_%s " n name;
 327            generate_c_call_args ~handle:"g" style;
 328            pr ";\n";
 329            do_cleanups ();
 330            pr "      if (%s == NULL)\n" n;
 331            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 332            pr "      RETVAL = newSVpv (%s, 0);\n" n;
 333            pr "      free (%s);\n" n;
 334            pr " OUTPUT:\n";
 335            pr "      RETVAL\n"
 336        | RStringList n | RHashtable n ->
 337            pr "PREINIT:\n";
 338            pr "      char **%s;\n" n;
 339            pr "      size_t i, n;\n";
 340            pr " PPCODE:\n";
 341            pr "      %s = guestfs_%s " n name;
 342            generate_c_call_args ~handle:"g" style;
 343            pr ";\n";
 344            do_cleanups ();
 345            pr "      if (%s == NULL)\n" n;
 346            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 347            pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
 348            pr "      EXTEND (SP, n);\n";
 349            pr "      for (i = 0; i < n; ++i) {\n";
 350            pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
 351            pr "        free (%s[i]);\n" n;
 352            pr "      }\n";
 353            pr "      free (%s);\n" n;
 354        | RStruct (n, typ) ->
 355            let cols = cols_of_struct typ in
 356            generate_perl_struct_code typ cols name style n do_cleanups
 357        | RStructList (n, typ) ->
 358            let cols = cols_of_struct typ in
 359            generate_perl_struct_list_code typ cols name style n do_cleanups
 360        | RBufferOut n ->
 361            pr "PREINIT:\n";
 362            pr "      char *%s;\n" n;
 363            pr "      size_t size;\n";
 364            pr "   CODE:\n";
 365            pr "      %s = guestfs_%s " n name;
 366            generate_c_call_args ~handle:"g" style;
 367            pr ";\n";
 368            do_cleanups ();
 369            pr "      if (%s == NULL)\n" n;
 370            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 371            pr "      RETVAL = newSVpvn (%s, size);\n" n;
 372            pr "      free (%s);\n" n;
 373            pr " OUTPUT:\n";
 374            pr "      RETVAL\n"
 375       );
 376
 377       pr "\n"
 378   ) all_functions
 379
 380 and generate_perl_struct_list_code typ cols name style n do_cleanups =
 381   pr "PREINIT:\n";
 382   pr "      struct guestfs_%s_list *%s;\n" typ n;
 383   pr "      size_t i;\n";
 384   pr "      HV *hv;\n";
 385   pr " PPCODE:\n";
 386   pr "      %s = guestfs_%s " n name;
 387   generate_c_call_args ~handle:"g" style;
 388   pr ";\n";
 389   do_cleanups ();
 390   pr "      if (%s == NULL)\n" n;
 391   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 392   pr "      EXTEND (SP, %s->len);\n" n;
 393   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
 394   pr "        hv = newHV ();\n";
 395   List.iter (
 396     function
 397     | name, FString ->
 398         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
 399           name (String.length name) n name
 400     | name, FUUID ->
 401         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
 402           name (String.length name) n name
 403     | name, FBuffer ->
 404         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
 405           name (String.length name) n name n name
 406     | name, (FBytes|FUInt64) ->
 407         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
 408           name (String.length name) n name
 409     | name, FInt64 ->
 410         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
 411           name (String.length name) n name
 412     | name, (FInt32|FUInt32) ->
 413         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
 414           name (String.length name) n name
 415     | name, FChar ->
 416         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
 417           name (String.length name) n name
 418     | name, FOptPercent ->
 419         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
 420           name (String.length name) n name
 421   ) cols;
 422   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
 423   pr "      }\n";
 424   pr "      guestfs_free_%s_list (%s);\n" typ n
 425
 426 and generate_perl_struct_code typ cols name style n do_cleanups =
 427   pr "PREINIT:\n";
 428   pr "      struct guestfs_%s *%s;\n" typ n;
 429   pr " PPCODE:\n";
 430   pr "      %s = guestfs_%s " n name;
 431   generate_c_call_args ~handle:"g" style;
 432   pr ";\n";
 433   do_cleanups ();
 434   pr "      if (%s == NULL)\n" n;
 435   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 436   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
 437   List.iter (
 438     fun ((name, _) as col) ->
 439       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
 440
 441       match col with
 442       | name, FString ->
 443           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
 444             n name
 445       | name, FBuffer ->
 446           pr "      PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
 447             n name n name
 448       | name, FUUID ->
 449           pr "      PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
 450             n name
 451       | name, (FBytes|FUInt64) ->
 452           pr "      PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
 453             n name
 454       | name, FInt64 ->
 455           pr "      PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
 456             n name
 457       | name, (FInt32|FUInt32) ->
 458           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
 459             n name
 460       | name, FChar ->
 461           pr "      PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
 462             n name
 463       | name, FOptPercent ->
 464           pr "      PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
 465             n name
 466   ) cols;
 467   pr "      free (%s);\n" n
 468
 469 (* Generate Sys/Guestfs.pm. *)
 470 and generate_perl_pm () =
 471   generate_header HashStyle LGPLv2plus;
 472
 473   pr "\
 474 =pod
 475
 476 =head1 NAME
 477
 478 Sys::Guestfs - Perl bindings for libguestfs
 479
 480 =head1 SYNOPSIS
 481
 482  use Sys::Guestfs;
 483
 484  my $h = Sys::Guestfs->new ();
 485  $h->add_drive ('guest.img');
 486  $h->launch ();
 487  $h->mount ('/dev/sda1', '/');
 488  $h->touch ('/hello');
 489  $h->sync ();
 490
 491 =head1 DESCRIPTION
 492
 493 The C<Sys::Guestfs> module provides a Perl XS binding to the
 494 libguestfs API for examining and modifying virtual machine
 495 disk images.
 496
 497 Amongst the things this is good for: making batch configuration
 498 changes to guests, getting disk used/free statistics (see also:
 499 virt-df), migrating between virtualization systems (see also:
 500 virt-p2v), performing partial backups, performing partial guest
 501 clones, cloning guests and changing registry/UUID/hostname info, and
 502 much else besides.
 503
 504 Libguestfs uses Linux kernel and qemu code, and can access any type of
 505 guest filesystem that Linux and qemu can, including but not limited
 506 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
 507 schemes, qcow, qcow2, vmdk.
 508
 509 Libguestfs provides ways to enumerate guest storage (eg. partitions,
 510 LVs, what filesystem is in each LV, etc.).  It can also run commands
 511 in the context of the guest.  Also you can access filesystems over
 512 FUSE.
 513
 514 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
 515 functions for using libguestfs from Perl, including integration
 516 with libvirt.
 517
 518 =head1 ERRORS
 519
 520 All errors turn into calls to C<croak> (see L<Carp(3)>).
 521
 522 =head1 METHODS
 523
 524 =over 4
 525
 526 =cut
 527
 528 package Sys::Guestfs;
 529
 530 use strict;
 531 use warnings;
 532
 533 # This version number changes whenever a new function
 534 # is added to the libguestfs API.  It is not directly
 535 # related to the libguestfs version number.
 536 use vars qw($VERSION);
 537 $VERSION = '0.%d';
 538
 539 require XSLoader;
 540 XSLoader::load ('Sys::Guestfs');
 541
 542 =item $h = Sys::Guestfs->new ();
 543
 544 Create a new guestfs handle.
 545
 546 =cut
 547
 548 sub new {
 549   my $proto = shift;
 550   my $class = ref ($proto) || $proto;
 551
 552   my $g = Sys::Guestfs::_create ();
 553   my $self = { _g => $g };
 554   bless $self, $class;
 555   return $self;
 556 }
 557
 558 =item $h->close ();
 559
 560 Explicitly close the guestfs handle.
 561
 562 B<Note:> You should not usually call this function.  The handle will
 563 be closed implicitly when its reference count goes to zero (eg.
 564 when it goes out of scope or the program ends).  This call is
 565 only required in some exceptional cases, such as where the program
 566 may contain cached references to the handle 'somewhere' and you
 567 really have to have the close happen right away.  After calling
 568 C<close> the program must not call any method (including C<close>)
 569 on the handle (but the implicit call to C<DESTROY> that happens
 570 when the final reference is cleaned up is OK).
 571
 572 =item $h->set_progress_callback (\\&cb);
 573
 574 Set the progress notification callback for this handle
 575 to the Perl closure C<cb>.
 576
 577 C<cb> will be called whenever a long-running operation
 578 generates a progress notification message.  The 4 parameters
 579 to the function are: C<proc_nr>, C<serial>, C<position>
 580 and C<total>.
 581
 582 You should carefully read the documentation for
 583 L<guestfs(3)/guestfs_set_progress_callback> before using
 584 this function.
 585
 586 =item $h->clear_progress_callback ();
 587
 588 This removes any progress callback function associated with
 589 the handle.
 590
 591 =cut
 592
 593 " max_proc_nr;
 594
 595   (* Actions.  We only need to print documentation for these as
 596    * they are pulled in from the XS code automatically.
 597    *)
 598   List.iter (
 599     fun (name, style, _, flags, _, _, longdesc) ->
 600       if not (List.mem NotInDocs flags) then (
 601         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
 602         pr "=item ";
 603         generate_perl_prototype name style;
 604         pr "\n\n";
 605         pr "%s\n\n" longdesc;
 606         if List.mem ProtocolLimitWarning flags then
 607           pr "%s\n\n" protocol_limit_warning;
 608         if List.mem DangerWillRobinson flags then
 609           pr "%s\n\n" danger_will_robinson;
 610         match deprecation_notice flags with
 611         | None -> ()
 612         | Some txt -> pr "%s\n\n" txt
 613       )
 614   ) all_functions_sorted;
 615
 616   (* End of file. *)
 617   pr "\
 618 =cut
 619
 620 1;
 621
 622 =back
 623
 624 =head1 AVAILABILITY
 625
 626 From time to time we add new libguestfs APIs.  Also some libguestfs
 627 APIs won't be available in all builds of libguestfs (the Fedora
 628 build is full-featured, but other builds may disable features).
 629 How do you test whether the APIs that your Perl program needs are
 630 available in the version of C<Sys::Guestfs> that you are using?
 631
 632 To test if a particular function is available in the C<Sys::Guestfs>
 633 class, use the ordinary Perl UNIVERSAL method C<can(METHOD)>
 634 (see L<perlobj(1)>).  For example:
 635
 636  use Sys::Guestfs;
 637  if (defined (Sys::Guestfs->can (\"set_verbose\"))) {
 638    print \"\\$h->set_verbose is available\\n\";
 639  }
 640
 641 To test if particular features are supported by the current
 642 build, use the L</available> method like the example below.  Note
 643 that the appliance must be launched first.
 644
 645  $h->available ( [\"augeas\"] );
 646
 647 Since the L</available> method croaks if the feature is not supported,
 648 you might also want to wrap this in an eval and return a boolean.
 649 In fact this has already been done for you: use
 650 L<Sys::Guestfs::Lib(3)/feature_available>.
 651
 652 For further discussion on this topic, refer to
 653 L<guestfs(3)/AVAILABILITY>.
 654
 655 =head1 STORING DATA IN THE HANDLE
 656
 657 The handle returned from L</new> is a hash reference.  The hash
 658 normally contains a single element:
 659
 660  {
 661    _g => [private data used by libguestfs]
 662  }
 663
 664 Callers can add other elements to this hash to store data for their own
 665 purposes.  The data lasts for the lifetime of the handle.
 666
 667 Any fields whose names begin with an underscore are reserved
 668 for private use by libguestfs.  We may add more in future.
 669
 670 It is recommended that callers prefix the name of their field(s)
 671 with some unique string, to avoid conflicts with other users.
 672
 673 =head1 COPYRIGHT
 674
 675 Copyright (C) %s Red Hat Inc.
 676
 677 =head1 LICENSE
 678
 679 Please see the file COPYING.LIB for the full license.
 680
 681 =head1 SEE ALSO
 682
 683 L<guestfs(3)>,
 684 L<guestfish(1)>,
 685 L<http://libguestfs.org>,
 686 L<Sys::Guestfs::Lib(3)>.
 687
 688 =cut
 689 " copyright_years
 690
 691 and generate_perl_prototype name style =
 692   (match fst style with
 693    | RErr -> ()
 694    | RBool n
 695    | RInt n
 696    | RInt64 n
 697    | RConstString n
 698    | RConstOptString n
 699    | RString n
 700    | RBufferOut n -> pr "$%s = " n
 701    | RStruct (n,_)
 702    | RHashtable n -> pr "%%%s = " n
 703    | RStringList n
 704    | RStructList (n,_) -> pr "@%s = " n
 705   );
 706   pr "$h->%s (" name;
 707   let comma = ref false in
 708   List.iter (
 709     fun arg ->
 710       if !comma then pr ", ";
 711       comma := true;
 712       match arg with
 713       | Pathname n | Device n | Dev_or_Path n | String n
 714       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n
 715       | BufferIn n | Key n ->
 716           pr "$%s" n
 717       | StringList n | DeviceList n ->
 718           pr "\\@%s" n
 719   ) (snd style);
 720   pr ");"