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