diff --git a/generator/perl.ml b/generator/perl.ml index bdfdb5b77..2aee66c61 100644 --- a/generator/perl.ml +++ b/generator/perl.ml @@ -39,7 +39,9 @@ let rec generate_perl_xs () = #include #include +#include #include +#include #include \"EXTERN.h\" #include \"perl.h\" @@ -294,6 +296,20 @@ PREINIT: guestfs_delete_event_callback (g, event_handle); } +SV * +event_to_string (event_bitmask) + int event_bitmask; +PREINIT: + char *str; + CODE: + str = guestfs_event_to_string (event_bitmask); + if (str == NULL) + croak (\"%%s\", strerror (errno)); + RETVAL = newSVpv (str, 0); + free (str); + OUTPUT: + RETVAL + SV * last_errno (g) guestfs_h *g; @@ -829,6 +845,13 @@ this function. This removes the callback which was previously registered using C. +=item $str = Sys::Guestfs::event_to_string ($events); + +C<$events> is either a single event or a bitmask of events. +This returns a printable string, useful for debugging. + +Note that this is a class function, not a method. + =item $errnum = $g->last_errno (); This returns the last error number (errno) that happened on the diff --git a/perl/t/400-events.t b/perl/t/400-events.t index bad687f86..aa323a621 100644 --- a/perl/t/400-events.t +++ b/perl/t/400-events.t @@ -34,8 +34,9 @@ sub log_callback { # We don't get to see this output because it is eaten up by the # test harness, but generate it anyway. - printf("perl event logged: event=0x%x eh=%d buf='%s' array=[%s]\n", - $ev, $eh, $buf, join (", ", @$array)); + printf("perl event logged: event=%s eh=%d buf='%s' array=[%s]\n", + Sys::Guestfs->event_to_string ($ev), + $eh, $buf, join (", ", @$array)); } my $close_invoked = 0;