experimental direct substr support

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

diff --git a/perlmod-test/src/pkg142.rs b/perlmod-test/src/pkg142.rs
index 964e94d4e335c4382c7095e51be30c6e4bd692e7..252b472ece3d3fdc925c4af3426586cce0e6cb90 100644 (file)
--- a/perlmod-test/src/pkg142.rs
+++ b/perlmod-test/src/pkg142.rs
@@ -80,6 +80,11 @@ mod export {
     fn testit(#[cv] cv: Value, arg: &str) {
         let _ = (cv, arg);
     }
+
+    #[export(raw_return)]
+    fn test_substr_return(#[raw] value: Value) -> Result<Value, Error> {
+        Ok(value.substr(3..6)?)
+    }
 }
 
 #[perlmod::package(name = "RSPM::EnvVarLibrary", lib = "x-${CARGO_PKG_NAME}-y")]

diff --git a/perlmod/src/ffi.rs b/perlmod/src/ffi.rs
index 9e0ce9f061c675f2e8cb16e585d59e86e5e79e11..8989886d307ececbb5c3f10dc6183285398dfc83 100644 (file)
--- a/perlmod/src/ffi.rs
+++ b/perlmod/src/ffi.rs
@@ -405,6 +405,10 @@ extern "C" {
     pub fn RSPL_MAGIC_ptr(mg: *const MAGIC) -> *const libc::c_char;
     pub fn RSPL_MAGIC_len(mg: *const MAGIC) -> isize;
     pub fn RSPL_PERL_MAGIC_ext() -> libc::c_int;
+
+    pub fn RSPL_PERL_MAGIC_substr() -> libc::c_int;
+    pub fn RSPL_vtbl_substr() -> *const MGVTBL;
+    pub fn RSPL_substr(orig: *mut SV, off: usize, len: usize) -> *mut SV;
 }
 
 /// Argument marker for the stack.

diff --git a/perlmod/src/glue.c b/perlmod/src/glue.c
index 38bef013de78c6a3a25db2e78e1ebcecb1fcbb1e..1c139d33d4b1c708e7cd7839c724ef66f912677e 100644 (file)
--- a/perlmod/src/glue.c
+++ b/perlmod/src/glue.c
@@ -356,6 +356,18 @@ extern SV* RSPL_LvTARG(SV *sv) {
     return LvTARG(sv);
 }
 
+/// Takes ownership of `orig`, returns an owned scalar.
+/// This does NOT check `off` and `len`. That's up to the caller.
+extern SV* RSPL_substr(SV *orig, usize off, usize len) {
+    SV *ret = newSV_type(SVt_PVLV);
+    sv_magic(ret, NULL, PERL_MAGIC_substr, NULL, 0);
+    LvTYPE(ret) = 'x';
+    LvTARG(ret) = orig;
+    LvTARGOFF(ret) = off;
+    LvTARGLEN(ret) = len;
+    return ret;
+}
+
 // We prefer this unsigned.
 //extern unsigned char RSPL_LvTYPE(SV *sv) {
 //    return (unsigned char)LvTYPE(sv);
@@ -377,6 +389,14 @@ extern void RSPL_SvGETMAGIC(SV *sv) {
     return SvGETMAGIC(sv);
 }
 
+extern const MGVTBL* RSPL_vtbl_substr() {
+    return &PL_vtbl_substr;
+}
+
+extern int RSPL_PERL_MAGIC_substr() {
+    return PERL_MAGIC_substr;
+}
+
 /// Create a new all-zeroes vtbl as perl docs suggest this is the safest way to
 /// make sure what a `PERL_MAGIC_ext` magic actually means, as the ptr value
 /// may be arbitrary. So this function is actually used to allocate "tags".

diff --git a/perlmod/src/scalar.rs b/perlmod/src/scalar.rs
index 28c863ed179558fa589c34110b391b8163296f92..ecb62779afa5e00b74b2c9619b512e5c673282ad 100644 (file)
--- a/perlmod/src/scalar.rs
+++ b/perlmod/src/scalar.rs
@@ -379,6 +379,65 @@ impl ScalarRef {
         }
     }
 
+    /// Check whether this value is a substring.
+    pub fn is_substr(&self) -> bool {
+        unsafe {
+            self.find_raw_magic(
+                Some(ffi::RSPL_PERL_MAGIC_substr()),
+                Some(&*ffi::RSPL_vtbl_substr()),
+            )
+            .is_some()
+        }
+    }
+
+    /// Create a substring from a string.
+    pub fn substr<I>(&self, index: I) -> Result<Scalar, Error>
+    where
+        I: std::slice::SliceIndex<[u8], Output = [u8]>,
+    {
+        let bytes = self.pv_bytes();
+        let slice: &[u8] = bytes
+            .get(index)
+            .ok_or_else(|| Error::new("substr with out of bounds range"))?;
+        let start = unsafe { slice.as_ptr().offset_from(bytes.as_ptr()) };
+        let start = usize::try_from(start).map_err(|_| Error::new("bad substr index"))?;
+
+        Ok(unsafe {
+            Scalar::from_raw_move(ffi::RSPL_substr(
+                ffi::RSPL_SvREFCNT_inc(self.sv()),
+                start,
+                slice.len(),
+            ))
+        })
+    }
+
+    /// Try to produce a substring from an existing "base" value and a `&str`.
+    ///
+    /// Returns `None` if `substr` is not part of `value`.
+    pub fn substr_from_str_slice(value: &ScalarRef, substr: &str) -> Result<Option<Scalar>, Error> {
+        let value_bytes = value.pv_bytes();
+        let value_beg = value_bytes.as_ptr() as usize;
+        let value_end = value_beg + value_bytes.len();
+        let value_range = value_beg..value_end;
+
+        let str_bytes = substr.as_bytes();
+        let str_beg = str_bytes.as_ptr() as usize;
+        let str_end = str_beg + str_bytes.len();
+        if !value_range.contains(&str_beg) || !value_range.contains(&str_end) {
+            return Ok(None);
+        }
+
+        // we just checked the ranges:
+        let start = unsafe { str_bytes.as_ptr().offset_from(value_bytes.as_ptr()) as usize };
+        Ok(Some(unsafe {
+            Scalar::from_raw_move(ffi::RSPL_substr(
+                ffi::RSPL_SvREFCNT_inc(value.sv()),
+                start,
+                substr.len(),
+            ))
+        }))
+    }
+
     /// Attach magic to this value.
     ///
     /// # Safety

diff --git a/perlmod/src/value.rs b/perlmod/src/value.rs
index 66ca0085ee0c0c008d9d5b7eb2f87102c3b64978..81651652e20248a90d9c15911bb1bfa85bd61ea2 100644 (file)
--- a/perlmod/src/value.rs
+++ b/perlmod/src/value.rs
@@ -388,6 +388,17 @@ impl Value {
         let _perl = Box::leak(box_);
         Ok(this)
     }
+
+    /// Attempt to create a substring, provided the contained value is actually a string.
+    pub fn substr<I>(&self, index: I) -> Result<Value, Error>
+    where
+        I: std::slice::SliceIndex<[u8], Output = [u8]>,
+    {
+        match self {
+            Value::Scalar(s) => s.substr(index).map(Value::Scalar),
+            _ => Err(Error::new("substr called on non-scalar")),
+        }
+    }
 }
 
 impl From<Scalar> for Value {

diff --git a/test.pl b/test.pl
index 87baec69ae808e4e9104ecddbb14b1aa27309f0a..5fe98ae5954f0b70e94cf662ed2f96ad98155ef5 100644 (file)
--- a/test.pl
+++ b/test.pl
@@ -115,3 +115,8 @@ print("Testing optional parameters\n");
 RSPM::Foo142::test_trailing_optional(1, 99);
 RSPM::Foo142::test_trailing_optional(2, undef);
 RSPM::Foo142::test_trailing_optional(3);
+
+print("Substring test\n");
+my $orig = "OneTwoThree";
+my $sub = RSPM::Foo142::test_substr_return($orig);
+print("[$orig] [$sub]\n");

diff --git a/test.pl.expected b/test.pl.expected
index 25465f920fe2332ea6a8f37e3fb632eab0f251eb..3220595a5c1a33d851b4a86e0238f3c2a7a70679 100644 (file)
--- a/test.pl.expected
+++ b/test.pl.expected
@@ -43,3 +43,5 @@ Testing optional parameters
 1, Some(99)
 2, None
 3, None
+Substring test
+[OneTwoThree] [Two]