105_scan_stash/
105_scan_stash.rs

1#[cfg(perlapi_ver26)]
2use std::env;
3
4#[cfg(perlapi_ver26)]
5use libperl_rs::*;
6
7#[cfg(perlapi_ver26)]
8mod eg;
9#[cfg(perlapi_ver26)]
10use eg::{op0::*,sv0::*,cv0::*,gv0::*};
11
12#[cfg(perlapi_ver26)]
13pub struct Walker<'a> {
14    pub perl: &'a Perl,
15    pub cv: *const libperl_sys::cv,
16}
17
18#[cfg(perlapi_ver26)]
19impl<'a> Walker<'a> {
20    pub fn walk(&'a self, o: *const op, level: isize) {
21        for kid in sibling_iter(o) {
22            self.walk(kid, level+1);
23        }
24        print!("{}", "  ".repeat(level as usize));
25        println!("{:?} {:?}", op_name(o), op_extract(&self.perl, self.cv, o));
26    }
27}
28
29#[cfg(perlapi_ver26)]
30fn my_test() {
31    let mut perl = Perl::new();
32    perl.parse_env_args(env::args(), env::vars());
33    
34    // get_cvstash(perl.get_main_cv()); returns null. Why?
35    
36    let stash = perl.get_defstash();
37    
38    assert_eq!(perl.gv_stashpv("main", 0), stash);
39    
40    let main_file = sv_extract_pv(perl.get_sv("0", 0)).unwrap();
41    println!("$0 = {:?}", main_file);
42
43    let emitter = |name: &String, cv: *const libperl_sys::cv| {
44        let walker = Walker {perl: &perl, cv};
45        println!("sub {:?} file {:?}", name, CvFILE(cv));
46        walker.walk(CvROOT(cv), 0);
47        println!("");
48    };
49
50    for (name, item) in eg::hv_iter0::HvIter::new(&perl, stash) {
51
52        // ref $main::{foo} eq 'CODE'
53        if let Some(Sv::CODE(cv)) = SvRV(item).map(|sv| sv_extract(sv)) {
54            emitter(&name, cv)
55        }
56        // ref (\$main::{foo}) eq 'GLOB'
57        else if let Sv::GLOB {gv, ..} = sv_extract(item) {
58            let cv = GvCV(gv);
59            if let Some(file) = CvFILE(cv) {
60                if file == main_file {
61                    emitter(&name, cv);
62                } else {
63                    println!("name = {:?} from file {:?}", name, file);
64                }
65            }
66        }
67        
68    }
69}
70
71#[cfg(not(perlapi_ver26))]
72fn my_test() {
73    println!("Requires perl >= 5.26");
74}
75
76fn main() {
77    my_test();
78}