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, (ret, args, optargs as style), _, _, _, _, _) ->
 203       (match ret 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       ) args;
 222       if optargs <> [] then
 223         pr ", ...";
 224       pr ")\n";
 225       pr "      guestfs_h *g;\n";
 226       iteri (
 227         fun i ->
 228           function
 229           | Pathname n | Device n | Dev_or_Path n | String n
 230           | FileIn n | FileOut n | Key n ->
 231               pr "      char *%s;\n" n
 232           | BufferIn n ->
 233               pr "      char *%s;\n" n;
 234               pr "      size_t %s_size = SvCUR (ST(%d));\n" n (i+1)
 235           | OptString n ->
 236               (* http://www.perlmonks.org/?node_id=554277
 237                * Note that the implicit handle argument means we have
 238                * to add 1 to the ST(x) operator.
 239                *)
 240               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
 241           | StringList n | DeviceList n -> pr "      char **%s;\n" n
 242           | Bool n -> pr "      int %s;\n" n
 243           | Int n -> pr "      int %s;\n" n
 244           | Int64 n -> pr "      int64_t %s;\n" n
 245       ) args;
 246
 247       (* PREINIT section (local variable declarations). *)
 248       pr "PREINIT:\n";
 249       (match ret with
 250        | RErr ->
 251            pr "      int r;\n";
 252        | RInt _
 253        | RBool _ ->
 254            pr "      int r;\n";
 255        | RInt64 _ ->
 256            pr "      int64_t r;\n";
 257        | RConstString _ ->
 258            pr "      const char *r;\n";
 259        | RConstOptString _ ->
 260            pr "      const char *r;\n";
 261        | RString _ ->
 262            pr "      char *r;\n";
 263        | RStringList _ | RHashtable _ ->
 264            pr "      char **r;\n";
 265            pr "      size_t i, n;\n";
 266        | RStruct (_, typ) ->
 267            pr "      struct guestfs_%s *r;\n" typ;
 268        | RStructList (_, typ) ->
 269            pr "      struct guestfs_%s_list *r;\n" typ;
 270            pr "      size_t i;\n";
 271            pr "      HV *hv;\n";
 272        | RBufferOut _ ->
 273            pr "      char *r;\n";
 274            pr "      size_t size;\n";
 275       );
 276
 277       if optargs <> [] then (
 278         pr "      struct guestfs_%s_argv optargs_s = { .bitmask = 0 };\n" name;
 279         pr "      struct guestfs_%s_argv *optargs = &optargs_s;\n" name;
 280         pr "      size_t items_i;\n";
 281       );
 282
 283       (* CODE or PPCODE section.  PPCODE is used where we are
 284        * returning void, or where we push the return value on the stack
 285        * ourselves.  Using CODE means we will manipulate RETVAL.
 286        *)
 287       (match ret with
 288        | RErr ->
 289            pr " PPCODE:\n";
 290        | RInt n
 291        | RBool n ->
 292            pr "   CODE:\n";
 293        | RInt64 n ->
 294            pr "   CODE:\n";
 295        | RConstString n ->
 296            pr "   CODE:\n";
 297        | RConstOptString n ->
 298            pr "   CODE:\n";
 299        | RString n ->
 300            pr "   CODE:\n";
 301        | RStringList n | RHashtable n ->
 302            pr " PPCODE:\n";
 303        | RBufferOut n ->
 304            pr "   CODE:\n";
 305        | RStruct _
 306        | RStructList _ ->
 307            pr " PPCODE:\n";
 308       );
 309
 310       (* For optional arguments, convert these from the XSUB "items"
 311        * variable by hand.
 312        *)
 313       if optargs <> [] then (
 314         let uc_name = String.uppercase name in
 315         let skip = List.length args + 1 in
 316         pr "      if (((items - %d) & 1) != 0)\n" skip;
 317         pr "        croak (\"expecting an even number of extra parameters\");\n";
 318         pr "      for (items_i = %d; items_i < items; items_i += 2) {\n" skip;
 319         pr "        uint64_t this_mask;\n";
 320         pr "        const char *this_arg;\n";
 321         pr "\n";
 322         pr "        this_arg = SvPV_nolen (ST (items_i));\n";
 323         pr "        ";
 324         List.iter (
 325           fun argt ->
 326             let n = name_of_argt argt in
 327             let uc_n = String.uppercase n in
 328             pr "if (strcmp (this_arg, \"%s\") == 0) {\n" n;
 329             pr "          optargs_s.%s = " n;
 330             (match argt with
 331              | Bool _
 332              | Int _
 333              | Int64 _ -> pr "SvIV (ST (items_i+1))"
 334              | String _ -> pr "SvPV_nolen (ST (items_i+1))"
 335              | _ -> assert false
 336             );
 337             pr ";\n";
 338             pr "          this_mask = GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n;
 339             pr "        }\n";
 340             pr "        else ";
 341         ) optargs;
 342         pr "croak (\"unknown optional argument '%%s'\", this_arg);\n";
 343         pr "        if (optargs_s.bitmask & this_mask)\n";
 344         pr "          croak (\"optional argument '%%s' given twice\",\n";
 345         pr "                 this_arg);\n";
 346         pr "        optargs_s.bitmask |= this_mask;\n";
 347         pr "      }\n";
 348         pr "\n";
 349       );
 350
 351       (* The call to the C function. *)
 352       if optargs = [] then
 353         pr "      r = guestfs_%s " name
 354       else
 355         pr "      r = guestfs_%s_argv " name;
 356       generate_c_call_args ~handle:"g" style;
 357       pr ";\n";
 358
 359       (* Cleanup any arguments. *)
 360       List.iter (
 361         function
 362         | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
 363         | Bool _ | Int _ | Int64 _
 364         | FileIn _ | FileOut _
 365         | BufferIn _ | Key _ -> ()
 366         | StringList n | DeviceList n -> pr "      free (%s);\n" n
 367       ) args;
 368
 369       (* Check return value for errors and return it if necessary. *)
 370       (match ret with
 371        | RErr ->
 372            pr "      if (r == -1)\n";
 373            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 374        | RInt n
 375        | RBool n ->
 376            pr "      if (r == -1)\n";
 377            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 378            pr "      RETVAL = newSViv (r);\n";
 379            pr " OUTPUT:\n";
 380            pr "      RETVAL\n"
 381        | RInt64 n ->
 382            pr "      if (r == -1)\n";
 383            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 384            pr "      RETVAL = my_newSVll (r);\n";
 385            pr " OUTPUT:\n";
 386            pr "      RETVAL\n"
 387        | RConstString n ->
 388            pr "      if (r == NULL)\n";
 389            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 390            pr "      RETVAL = newSVpv (r, 0);\n";
 391            pr " OUTPUT:\n";
 392            pr "      RETVAL\n"
 393        | RConstOptString n ->
 394            pr "      if (r == NULL)\n";
 395            pr "        RETVAL = &PL_sv_undef;\n";
 396            pr "      else\n";
 397            pr "        RETVAL = newSVpv (r, 0);\n";
 398            pr " OUTPUT:\n";
 399            pr "      RETVAL\n"
 400        | RString n ->
 401            pr "      if (r == NULL)\n";
 402            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 403            pr "      RETVAL = newSVpv (r, 0);\n";
 404            pr "      free (r);\n";
 405            pr " OUTPUT:\n";
 406            pr "      RETVAL\n"
 407        | RStringList n | RHashtable n ->
 408            pr "      if (r == NULL)\n";
 409            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 410            pr "      for (n = 0; r[n] != NULL; ++n) /**/;\n";
 411            pr "      EXTEND (SP, n);\n";
 412            pr "      for (i = 0; i < n; ++i) {\n";
 413            pr "        PUSHs (sv_2mortal (newSVpv (r[i], 0)));\n";
 414            pr "        free (r[i]);\n";
 415            pr "      }\n";
 416            pr "      free (r);\n";
 417        | RStruct (n, typ) ->
 418            let cols = cols_of_struct typ in
 419            generate_perl_struct_code typ cols name style n
 420        | RStructList (n, typ) ->
 421            let cols = cols_of_struct typ in
 422            generate_perl_struct_list_code typ cols name style n
 423        | RBufferOut n ->
 424            pr "      if (r == NULL)\n";
 425            pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 426            pr "      RETVAL = newSVpvn (r, size);\n";
 427            pr "      free (r);\n";
 428            pr " OUTPUT:\n";
 429            pr "      RETVAL\n"
 430       );
 431
 432       pr "\n"
 433   ) all_functions
 434
 435 and generate_perl_struct_list_code typ cols name style n =
 436   pr "      if (r == NULL)\n";
 437   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 438   pr "      EXTEND (SP, r->len);\n";
 439   pr "      for (i = 0; i < r->len; ++i) {\n";
 440   pr "        hv = newHV ();\n";
 441   List.iter (
 442     function
 443     | name, FString ->
 444         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (r->val[i].%s, 0), 0);\n"
 445           name (String.length name) name
 446     | name, FUUID ->
 447         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (r->val[i].%s, 32), 0);\n"
 448           name (String.length name) name
 449     | name, FBuffer ->
 450         pr "        (void) hv_store (hv, \"%s\", %d, newSVpvn (r->val[i].%s, r->val[i].%s_len), 0);\n"
 451           name (String.length name) name name
 452     | name, (FBytes|FUInt64) ->
 453         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (r->val[i].%s), 0);\n"
 454           name (String.length name) name
 455     | name, FInt64 ->
 456         pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (r->val[i].%s), 0);\n"
 457           name (String.length name) name
 458     | name, (FInt32|FUInt32) ->
 459         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (r->val[i].%s), 0);\n"
 460           name (String.length name) name
 461     | name, FChar ->
 462         pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (&r->val[i].%s, 1), 0);\n"
 463           name (String.length name) name
 464     | name, FOptPercent ->
 465         pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (r->val[i].%s), 0);\n"
 466           name (String.length name) name
 467   ) cols;
 468   pr "        PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
 469   pr "      }\n";
 470   pr "      guestfs_free_%s_list (r);\n" typ
 471
 472 and generate_perl_struct_code typ cols name style n =
 473   pr "      if (r == NULL)\n";
 474   pr "        croak (\"%%s\", guestfs_last_error (g));\n";
 475   pr "      EXTEND (SP, 2 * %d);\n" (List.length cols);
 476   List.iter (
 477     fun ((name, _) as col) ->
 478       pr "      PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
 479
 480       match col with
 481       | name, FString ->
 482           pr "      PUSHs (sv_2mortal (newSVpv (r->%s, 0)));\n"
 483             name
 484       | name, FBuffer ->
 485           pr "      PUSHs (sv_2mortal (newSVpvn (r->%s, r->%s_len)));\n"
 486             name name
 487       | name, FUUID ->
 488           pr "      PUSHs (sv_2mortal (newSVpv (r->%s, 32)));\n"
 489             name
 490       | name, (FBytes|FUInt64) ->
 491           pr "      PUSHs (sv_2mortal (my_newSVull (r->%s)));\n"
 492             name
 493       | name, FInt64 ->
 494           pr "      PUSHs (sv_2mortal (my_newSVll (r->%s)));\n"
 495             name
 496       | name, (FInt32|FUInt32) ->
 497           pr "      PUSHs (sv_2mortal (newSVnv (r->%s)));\n"
 498             name
 499       | name, FChar ->
 500           pr "      PUSHs (sv_2mortal (newSVpv (&r->%s, 1)));\n"
 501             name
 502       | name, FOptPercent ->
 503           pr "      PUSHs (sv_2mortal (newSVnv (r->%s)));\n"
 504             name
 505   ) cols;
 506   pr "      free (r);\n"
 507
 508 (* Generate Sys/Guestfs.pm. *)
 509 and generate_perl_pm () =
 510   generate_header HashStyle LGPLv2plus;
 511
 512   pr "\
 513 =pod
 514
 515 =head1 NAME
 516
 517 Sys::Guestfs - Perl bindings for libguestfs
 518
 519 =head1 SYNOPSIS
 520
 521  use Sys::Guestfs;
 522
 523  my $h = Sys::Guestfs->new ();
 524  $h->add_drive_opts ('guest.img', format => 'raw');
 525  $h->launch ();
 526  $h->mount_options ('', '/dev/sda1', '/');
 527  $h->touch ('/hello');
 528  $h->sync ();
 529
 530 =head1 DESCRIPTION
 531
 532 The C<Sys::Guestfs> module provides a Perl XS binding to the
 533 libguestfs API for examining and modifying virtual machine
 534 disk images.
 535
 536 Amongst the things this is good for: making batch configuration
 537 changes to guests, getting disk used/free statistics (see also:
 538 virt-df), migrating between virtualization systems (see also:
 539 virt-p2v), performing partial backups, performing partial guest
 540 clones, cloning guests and changing registry/UUID/hostname info, and
 541 much else besides.
 542
 543 Libguestfs uses Linux kernel and qemu code, and can access any type of
 544 guest filesystem that Linux and qemu can, including but not limited
 545 to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
 546 schemes, qcow, qcow2, vmdk.
 547
 548 Libguestfs provides ways to enumerate guest storage (eg. partitions,
 549 LVs, what filesystem is in each LV, etc.).  It can also run commands
 550 in the context of the guest.  Also you can access filesystems over
 551 FUSE.
 552
 553 See also L<Sys::Guestfs::Lib(3)> for a set of useful library
 554 functions for using libguestfs from Perl, including integration
 555 with libvirt.
 556
 557 =head1 ERRORS
 558
 559 All errors turn into calls to C<croak> (see L<Carp(3)>).
 560
 561 =head1 METHODS
 562
 563 =over 4
 564
 565 =cut
 566
 567 package Sys::Guestfs;
 568
 569 use strict;
 570 use warnings;
 571
 572 # This version number changes whenever a new function
 573 # is added to the libguestfs API.  It is not directly
 574 # related to the libguestfs version number.
 575 use vars qw($VERSION);
 576 $VERSION = '0.%d';
 577
 578 require XSLoader;
 579 XSLoader::load ('Sys::Guestfs');
 580
 581 =item $h = Sys::Guestfs->new ();
 582
 583 Create a new guestfs handle.
 584
 585 =cut
 586
 587 sub new {
 588   my $proto = shift;
 589   my $class = ref ($proto) || $proto;
 590
 591   my $g = Sys::Guestfs::_create ();
 592   my $self = { _g => $g };
 593   bless $self, $class;
 594   return $self;
 595 }
 596
 597 =item $h->close ();
 598
 599 Explicitly close the guestfs handle.
 600
 601 B<Note:> You should not usually call this function.  The handle will
 602 be closed implicitly when its reference count goes to zero (eg.
 603 when it goes out of scope or the program ends).  This call is
 604 only required in some exceptional cases, such as where the program
 605 may contain cached references to the handle 'somewhere' and you
 606 really have to have the close happen right away.  After calling
 607 C<close> the program must not call any method (including C<close>)
 608 on the handle (but the implicit call to C<DESTROY> that happens
 609 when the final reference is cleaned up is OK).
 610
 611 =item $h->set_progress_callback (\\&cb);
 612
 613 Set the progress notification callback for this handle
 614 to the Perl closure C<cb>.
 615
 616 C<cb> will be called whenever a long-running operation
 617 generates a progress notification message.  The 4 parameters
 618 to the function are: C<proc_nr>, C<serial>, C<position>
 619 and C<total>.
 620
 621 You should carefully read the documentation for
 622 L<guestfs(3)/guestfs_set_progress_callback> before using
 623 this function.
 624
 625 =item $h->clear_progress_callback ();
 626
 627 This removes any progress callback function associated with
 628 the handle.
 629
 630 =cut
 631
 632 " max_proc_nr;
 633
 634   (* Actions.  We only need to print documentation for these as
 635    * they are pulled in from the XS code automatically.
 636    *)
 637   List.iter (
 638     fun (name, style, _, flags, _, _, longdesc) ->
 639       if not (List.mem NotInDocs flags) then (
 640         let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
 641         pr "=item ";
 642         generate_perl_prototype name style;
 643         pr "\n\n";
 644         pr "%s\n\n" longdesc;
 645         if List.mem ProtocolLimitWarning flags then
 646           pr "%s\n\n" protocol_limit_warning;
 647         if List.mem DangerWillRobinson flags then
 648           pr "%s\n\n" danger_will_robinson;
 649         match deprecation_notice flags with
 650         | None -> ()
 651         | Some txt -> pr "%s\n\n" txt
 652       )
 653   ) all_functions_sorted;
 654
 655   (* End of file. *)
 656   pr "\
 657 =cut
 658
 659 1;
 660
 661 =back
 662
 663 =head1 AVAILABILITY
 664
 665 From time to time we add new libguestfs APIs.  Also some libguestfs
 666 APIs won't be available in all builds of libguestfs (the Fedora
 667 build is full-featured, but other builds may disable features).
 668 How do you test whether the APIs that your Perl program needs are
 669 available in the version of C<Sys::Guestfs> that you are using?
 670
 671 To test if a particular function is available in the C<Sys::Guestfs>
 672 class, use the ordinary Perl UNIVERSAL method C<can(METHOD)>
 673 (see L<perlobj(1)>).  For example:
 674
 675  use Sys::Guestfs;
 676  if (defined (Sys::Guestfs->can (\"set_verbose\"))) {
 677    print \"\\$h->set_verbose is available\\n\";
 678  }
 679
 680 To test if particular features are supported by the current
 681 build, use the L</available> method like the example below.  Note
 682 that the appliance must be launched first.
 683
 684  $h->available ( [\"augeas\"] );
 685
 686 Since the L</available> method croaks if the feature is not supported,
 687 you might also want to wrap this in an eval and return a boolean.
 688 In fact this has already been done for you: use
 689 L<Sys::Guestfs::Lib(3)/feature_available>.
 690
 691 For further discussion on this topic, refer to
 692 L<guestfs(3)/AVAILABILITY>.
 693
 694 =head1 STORING DATA IN THE HANDLE
 695
 696 The handle returned from L</new> is a hash reference.  The hash
 697 normally contains a single element:
 698
 699  {
 700    _g => [private data used by libguestfs]
 701  }
 702
 703 Callers can add other elements to this hash to store data for their own
 704 purposes.  The data lasts for the lifetime of the handle.
 705
 706 Any fields whose names begin with an underscore are reserved
 707 for private use by libguestfs.  We may add more in future.
 708
 709 It is recommended that callers prefix the name of their field(s)
 710 with some unique string, to avoid conflicts with other users.
 711
 712 =head1 COPYRIGHT
 713
 714 Copyright (C) %s Red Hat Inc.
 715
 716 =head1 LICENSE
 717
 718 Please see the file COPYING.LIB for the full license.
 719
 720 =head1 SEE ALSO
 721
 722 L<guestfs(3)>,
 723 L<guestfish(1)>,
 724 L<http://libguestfs.org>,
 725 L<Sys::Guestfs::Lib(3)>.
 726
 727 =cut
 728 " copyright_years
 729
 730 and generate_perl_prototype name (ret, args, optargs) =
 731   (match ret with
 732    | RErr -> ()
 733    | RBool n
 734    | RInt n
 735    | RInt64 n
 736    | RConstString n
 737    | RConstOptString n
 738    | RString n
 739    | RBufferOut n -> pr "$%s = " n
 740    | RStruct (n,_)
 741    | RHashtable n -> pr "%%%s = " n
 742    | RStringList n
 743    | RStructList (n,_) -> pr "@%s = " n
 744   );
 745   pr "$h->%s (" name;
 746   let comma = ref false in
 747   List.iter (
 748     fun arg ->
 749       if !comma then pr ", ";
 750       comma := true;
 751       match arg with
 752       | Pathname n | Device n | Dev_or_Path n | String n
 753       | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n
 754       | BufferIn n | Key n ->
 755           pr "$%s" n
 756       | StringList n | DeviceList n ->
 757           pr "\\@%s" n
 758   ) args;
 759   List.iter (
 760     fun arg ->
 761       if !comma then pr " [, " else pr "[";
 762       comma := true;
 763       let n = name_of_argt arg in
 764       pr "%s => $%s]" n n
 765   ) optargs;
 766   pr ");"