destructor macro and helpers for blessed objects

Signed-off-by: Wolfgang Bumiller <w.bumiller@proxmox.com>

perlmod-test/src/bless.rs

@@ -1,6 +1,6 @@
 #[perlmod::package(name = "RSPM::Bless", lib = "perlmod_test")]
 mod export {
-    use anyhow::{format_err, Error};
+    use anyhow::Error;
 
     use perlmod::Value;
 
@@ -21,34 +21,11 @@ mod export {
     }
 
     #[export]
-    fn something(#[raw] value: Value) {
-        let _ = value; // ignore for now
-        println!("Called something!");
+    fn something(#[raw] this: Value) -> Result<(), Error> {
+        let this = unsafe { this.from_blessed_box::<Bless>("RSPM::Bless")? };
+        println!("Called something on Bless {{ {:?} }}!", this.content);
+        Ok(())
     }
 
-    #[export(name = "DESTROY")]
-    fn destroy(#[raw] this: Value) {
-        match this
-            .dereference()
-            .ok_or_else(|| format_err!("not a reference"))
-            .and_then(|this| Ok(this.pv_raw()?))
-        {
-            Ok(ptr) => {
-                let value = unsafe { Box::<Bless>::from_raw(ptr) };
-                println!("Dropping value {:?}", value.content);
-            }
-            Err(err) => {
-                println!("DESTROY called with invalid pointer: {}", err);
-            }
-        }
-    }
+    perlmod::destructor! { Bless : "RSPM::Bless" }
 }
-
-// Example:
-// use RSPM::Bless;
-// my $foo = RSPM::Bless::new("Some Content");
-// $foo->something(); // works
-//
-// output:
-// Called something!
-// Dropping value "Some Content"

perlmod/src/error.rs

@@ -16,6 +16,11 @@ impl Error {
         Self(s.to_string())
     }
 
+    #[inline]
+    pub fn new_owned(s: String) -> Self {
+        Self(s)
+    }
+
     #[inline]
     pub fn fail<T>(s: &str) -> Result<T, Self> {
         Err(Self(s.to_string()))

perlmod/src/ffi.rs

@@ -105,6 +105,8 @@ extern "C" {
     pub fn RSPL_SAVETMPS();
     pub fn RSPL_FREETMPS();
     pub fn RSPL_LEAVE();
+
+    pub fn RSPL_sv_reftype(sv: *const SV, ob: libc::c_int) -> *const libc::c_char;
 }
 
 /// Argument marker for the stack.

perlmod/src/glue.c

@@ -297,6 +297,10 @@ extern void RSPL_LEAVE() {
     LEAVE;
 }
 
+extern const char* RSPL_sv_reftype(const SV *const sv, const int ob) {
+    return sv_reftype(sv, ob);
+}
+
 /*
 These make are convoluted brainfarts:
         SVt_NULL                 undef

perlmod/src/lib.rs

@@ -12,6 +12,9 @@
 pub(crate) mod error;
 pub use error::Error;
 
+#[macro_use]
+mod macros;
+
 pub mod de;
 pub mod ffi;
 pub mod ser;

perlmod/src/macros.rs

@@ -0,0 +1,94 @@
+/// Convenience macros.
+
+/// Create a standard destructor for a boxed type.
+///
+/// For safety it is recommended to pass the package name to the macro in order for the generated
+/// code to also guard against values not blessed into the package.
+///
+/// Custom code for when an invalid value is passed to the function can be provided as follows:
+///
+/// Usage:
+/// ```ignore
+/// // complete:
+/// destructor!(MyType : "My::RS::Package" {
+///     Err(err) => { eprintln!("DESTROY called with invalid pointer: {}", err); }
+/// });
+///
+/// // error case only
+/// destructor!(MyType {
+///     Err(err) => { eprintln!("DESTROY called with invalid pointer: {}", err); }
+/// });
+///
+/// // simple case with default error case (which is the above example case)
+/// destructor!(MyType : "My::RS::Package");
+///
+/// // simple less-safe case without checking the reference type.
+/// destructor!(MyType);
+/// ```
+///
+/// The generated code looks like this:
+///
+/// ```ignore
+/// #[export(name = "DESTROY")]
+/// fn destroy(#[raw] this: Value) {
+///     match this.from_blessed_box::<MyType>("My::RS::Package") {
+///         Ok(ptr) => {
+///             let _ = unsafe { Box::<MyType>::from_raw(ptr) };
+///         }
+///         Err(err) => {
+///             // this is the default error handler:
+///             eprintln!("DESTROY called with invalid pointer: {}", err);
+///         }
+///     }
+/// }
+/// ```
+#[macro_export]
+macro_rules! destructor {
+    ($ty:ty : $package:literal) => {
+        $crate::destructor! {
+            $ty : $package {
+                Err(err) => {
+                    eprintln!("DESTROY called with invalid pointer: {}", err);
+                }
+            }
+        }
+    };
+
+    ($ty:ty : $package:literal {
+        Err($errname:ident) => $on_err:expr
+    }) => {
+        #[perlmod::export(name = "DESTROY")]
+        fn destroy(#[raw] this: Value) {
+            match unsafe { this.from_blessed_box::<$ty>($package) } {
+                Ok(ptr) => {
+                    let _ = unsafe { Box::<$ty>::from_raw(ptr as *const $ty as *mut $ty) };
+                }
+                Err($errname) => $on_err,
+            }
+        }
+    };
+
+    ($ty:ty) => {
+        $crate::destructor! {
+            $ty {
+                Err(err) => {
+                    eprintln!("DESTROY called with invalid pointer: {}", err);
+                }
+            }
+        }
+    };
+
+    ($ty:ty {
+        Err($name:ident) => $on_err:expr
+    }) => {
+        #[perlmod::export(name = "DESTROY")]
+        fn destroy(#[raw] this: Value) {
+            match unsafe { this.from_ref_box::<$ty>() } {
+                Ok(ptr) => {
+                    let _ = unsafe { Box::<Bless>::from_raw(ptr) };
+                }
+                Err($name) => $on_err,
+            }
+        }
+    };
+}

perlmod/src/scalar.rs

@@ -305,6 +305,24 @@ impl ScalarRef {
     pub fn into_value(self) -> Value {
         Value::from_scalar(self.clone_ref())
     }
+
+    /// Get the reference type for this value. (Similar to `ref` in perl).
+    ///
+    /// If `blessed` is true and the value is a blessed reference, the package name will be
+    /// returned, otherwise the scalar type (`"SCALAR"`, `"ARRAY"`, ...) will be returned.
+    pub fn reftype(&self, blessed: bool) -> &'static str {
+        let ptr = unsafe { ffi::RSPL_sv_reftype(self.sv(), if blessed { 1 } else { 0 }) };
+
+        if ptr.is_null() {
+            "<UNKNOWN>"
+        } else {
+            unsafe {
+                std::ffi::CStr::from_ptr(ptr)
+                    .to_str()
+                    .unwrap_or("<NON-UTF8-CLASSNAME>")
+            }
+        }
+    }
 }
 
 impl std::fmt::Debug for Scalar {

perlmod/src/value.rs

@@ -224,6 +224,46 @@ impl Value {
             None
         }
     }
+
+    /// Check that the value is a reference and if so, assume it is a reference to a boxed rust
+    /// type and return a reference to it.
+    ///
+    /// # Safety
+    ///
+    /// This is mainly a helper to be used for blessed values. This only checks that the value
+    /// itself is any kind of reference, then assumes it contains something resembling a pointer
+    /// (see [`Value::pv_raw`]), and if so, simply casts it to `T`.
+    pub unsafe fn from_ref_box<T>(&self) -> Result<&T, Error> {
+        let ptr = self
+            .dereference()
+            .ok_or_else(|| Error::new("not a reference"))?
+            .pv_raw()?;
+        Ok(&*(ptr as *const T))
+    }
+
+    /// Check that the value is a reference and blessed into a particular package name. If so,
+    /// assume it is a referenced to a boxed rust type and return a reference to it.
+    ///
+    /// # Safety
+    ///
+    /// See [`Value::from_ref_box`]. This additionally uses [`Value::reftype`] to check that the
+    /// passed value was indeed blessed into the provided `package` name. Other than that, it
+    /// cannot verify the the contained pointer is truly a `T`.
+    pub unsafe fn from_blessed_box<'a, T>(&'a self, package: &'_ str) -> Result<&'a T, Error> {
+        let ptr = self
+            .dereference()
+            .ok_or_else(|| Error::new("not a reference"))?;
+
+        let reftype = ptr.reftype(true);
+        if reftype != package {
+            return Err(Error::new_owned(format!(
+                "value not blessed into {:?} (`ref` returned {:?})",
+                package, reftype,
+            )));
+        }
+
+        Ok(&*(ptr.pv_raw()? as *const T))
+    }
 }
 
 impl From<Scalar> for Value {