00001 
00008 #include <string>
00009 #include <vector>
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 extern "C" {
00020 #include "EXTERN.h"
00021 #include "perl.h"
00022 #include "XSUB.h"
00023 #include "ppport.h"
00024 #include <cstdarg>
00025 };
00026 
00027 namespace pl {
00028     class Str;
00029     class UInt;
00030     class Int;
00031     class Double;
00032     class Pointer;
00033     class Reference;
00034     class Hash;
00035     class Array;
00036     class Package;
00037     class Code;
00038     class Ctx;
00039 
00043     class Value {
00044         friend class Ctx;
00045         friend class Reference;
00046         friend class Array;
00047         friend class Perl;
00048         friend class Hash;
00049         friend class Package;
00050         friend class Code;
00051 
00052     public:
00057         void dump() {
00058             sv_dump(val);
00059         }
00064         void refcnt_inc() {
00065             SvREFCNT_inc(this->val);
00066         }
00071         void refcnt_dec() {
00072             SvREFCNT_dec(this->val);
00073         }
00077         Reference* reference();
00078     protected:
00079         SV* val;
00080         Value() { }
00081         Value(SV* _v) {
00082             this->val = _v;
00083         }
00084     };
00085 
00089     class Scalar : public Value {
00090         friend class Ctx;
00091         friend class Reference;
00092         friend class Array;
00093         friend class Perl;
00094         friend class Hash;
00095         friend class Package;
00096         friend class Code;
00097 
00098     public:
00103         Scalar * mortal() {
00104             sv_2mortal(this->val);
00105             return this;
00106         }
00110         SV * serialize() {
00111             return val;
00112         }
00116         Str* as_str();
00120         Int* as_int();
00124         UInt* as_uint();
00128         Double* as_double();
00132         Pointer* as_pointer();
00136         Reference* as_ref();
00137     protected:
00138         Scalar(SV* _v) : Value(_v) { }
00139     };
00140 
00144     class Boolean : public Scalar {
00145     public:
00146         Boolean(bool b) : Scalar(b ? &PL_sv_yes : &PL_sv_no) { }
00151         static Boolean* yes();
00156         static Boolean* no();
00157     };
00161     class Int : public Scalar {
00162         friend class Scalar;
00163     public:
00164         Int(int _i) : Scalar(newSViv(_i)) { }
00168         int to_c() {
00169             return SvIV(this->val);
00170         }
00171     protected:
00172         Int(SV* _s) : Scalar(_s) { }
00173     };
00177     class UInt : public Scalar {
00178         friend class Scalar;
00179     public:
00180         UInt(unsigned int _i) : Scalar(newSVuv(_i)) { }
00184         unsigned int to_c() {
00185             return SvUV(this->val);
00186         }
00187     protected:
00188         UInt(SV* _s) : Scalar(_s) { }
00189     };
00193     class Double : public Scalar {
00194         friend class Scalar;
00195     public:
00196         Double(double _i) : Scalar(newSVnv(_i)) { }
00200         double to_c() {
00201             return SvNV(this->val);
00202         }
00203     protected:
00204         Double(SV* _s) : Scalar(_s) { }
00205     };
00209     class Str : public Scalar {
00210         friend class Scalar;
00211     public:
00212         Str(std::string & _s) : Scalar(newSVpv(_s.c_str(), _s.length())) { }
00213         Str(const char* _s) : Scalar(newSVpv(_s, strlen(_s))) { }
00214         Str(const char* _s, int _n) : Scalar(newSVpv(_s, _n)) { }
00218         const char* to_c() {
00219             return SvPV_nolen(this->val);
00220         }
00224         void concat(const char* s, I32 len) {
00225             sv_catpvn(this->val, s, len);
00226         }
00227         void concat(const char* s) {
00228             sv_catpv(this->val, s);
00229         }
00230         void concat(Str* s) {
00231             sv_catsv(this->val, s->val);
00232         }
00234         int length() {
00235             return sv_len(this->val);
00236         }
00237     protected:
00238         Str(SV* _s) : Scalar(_s) { }
00239     };
00240 
00244     class Reference : public Scalar {
00245         friend class Scalar;
00246         friend class Hash;
00247         friend class Array;
00248     public:
00252         static Reference * new_inc(Value* thing);
00254         void bless(const char *pkg) {
00255             HV * stash = gv_stashpv(pkg, TRUE);
00256             sv_bless(this->val, stash);
00257         }
00259         Hash * as_hash();
00261         Array * as_array();
00263         Scalar * as_scalar();
00265         Code* as_code();
00269         bool is_object() {
00270             return sv_isobject(this->val);
00271         }
00272     protected:
00273         Reference(SV*v) : Scalar(v) { }
00274     };
00275 
00279     class Hash : public Value {
00280         friend class Reference;
00281     public:
00282         Hash() : Value((SV*)newHV()) { }
00284         Reference * fetch(const char *key);
00286         bool exists(const char*key) {
00287             return this->exists(key, strlen(key));
00288         }
00290         bool exists(const char*key, I32 klen) {
00291             return hv_exists((HV*)this->val, key, klen);
00292         }
00294         Reference* del(const char*key) {
00295             return this->del(key, strlen(key));
00296         }
00298         Reference* del(const char*key, I32 klen);
00299 
00301         void store(const char*key, Scalar*value) {
00302             this->store(key, strlen(key), value);
00303         }
00304         void store(const char*key, Scalar value) {
00305             this->store(key, strlen(key), &value);
00306         }
00308         void  store(const char*key, I32 klen, Scalar*value);
00310         Scalar* scalar();
00312         void undef();
00314         void clear();
00315     protected:
00316         Hash(HV* _h) : Value((SV*)_h) { }
00317     };
00318 
00322     class Array : public Value {
00323         friend class Reference;
00324     public:
00325         Array() : Value((SV*)newAV()) { }
00327         void push(Value v) {
00328             this->push(&v);
00329         }
00331         void push(Value * v) {
00332             v->refcnt_inc();
00333             av_push((AV*)this->val, v->val);
00334         }
00339         void unshift(Int &i) {
00340             this->unshift(i.to_c());
00341         }
00342         void unshift(I32 i) {
00343             av_unshift((AV*)this->val, i);
00344         }
00346         Scalar * pop();
00348         Scalar * shift();
00350         Reference * fetch(I32 key);
00351 
00353         I32 len() {
00354             return av_len((AV*)this->val);
00355         }
00357         U32 size() {
00358             return this->len() + 1;
00359         }
00360 
00362         Scalar * store(I32 key, Scalar* v);
00364         void clear() {
00365             av_clear((AV*)this->val);
00366         }
00368         void undef() {
00369             av_undef((AV*)this->val);
00370         }
00372         void extend(I32 n) {
00373             av_extend((AV*)this->val, n);
00374         }
00375     protected:
00376         Array(AV* _a) : Value((SV*)_a) { }
00377     };
00378 
00382     class Carp {
00383     public:
00384         static void croak(const char * format, ...) {
00385             va_list args;
00386             va_start(args, format);
00387             Perl_vcroak(aTHX_ format, &args);
00388             va_end(args);
00389         }
00390         static void warn(const char * format, ...) {
00391             va_list args;
00392             va_start(args, format);
00393             Perl_vwarn(aTHX_ format, &args);
00394             va_end(args);
00395         }
00396     };
00397 
00398 
00402     class Ctx {
00403     public:
00404         Ctx();
00405         Ctx(int arg_cnt);
00406         ~Ctx();
00408         I32 arg_len() {
00409             return (I32)(PL_stack_sp - mark);
00410         }
00412         Scalar* arg(int n) {
00413             Scalar*s = new Scalar(fetch_stack(n));
00414             this->register_allocated(s);
00415             return s;
00416         }
00418         void ret(Scalar s) {
00419             this->ret(0, &s);
00420         }
00421         void ret(Scalar* s) {
00422             this->ret(0, s);
00423         }
00424         void ret(int n, Scalar* s) {
00425             this->ret(n, s ? s->serialize() : &PL_sv_undef);
00426         }
00428         bool wantarray() {
00429             return GIMME_V & G_ARRAY ? true : false;
00430         }
00432         void ret(Array* ary) {
00433             unsigned int size = ary->size();
00434             if (size != 0) {
00435                 SV** sp = PL_stack_sp;
00436                 if ((unsigned int)(PL_stack_max - sp) < size) {
00437                     sp = stack_grow(sp, sp, size);
00438                 }
00439 
00440                 for (unsigned int i=0; i < size; ++i) {
00441                     Scalar * s = ary->fetch(i);
00442                     PL_stack_base[ax++] = s->val;
00443                 }
00444                 ax--;
00445             } else {
00446                 this->return_undef();
00447             }
00448         }
00450         void return_true() {
00451             this->ret(0, &PL_sv_yes);
00452         }
00454         void return_undef() {
00455             this->ret(0, &PL_sv_undef);
00456         }
00462         void register_allocated(Value* v) {
00463             allocated.push_back(v);
00464         }
00465     protected:
00470         SV* fetch_stack(int n) {
00471             return PL_stack_base[this->ax + n];
00472         }
00473         void ret(int n, SV* s) {
00474             PL_stack_base[ax + n] = s;
00475         }
00476         void initialize();
00477         I32 ax;
00478         SV ** mark;
00479         std::vector<Value*> allocated;
00480     };
00481     std::vector<Ctx*> ctxstack;
00482     Ctx::Ctx() {
00483         this->initialize();
00484     }
00485     Ctx::Ctx(int arg_cnt) {
00486         this->initialize();
00487 
00488         int got = arg_len();
00489         if (arg_cnt != got) {
00490             Carp::croak("This method requires %d arguments, but %d", arg_cnt, got);
00491         }
00492     }
00493     void Ctx::initialize() {
00494         
00495         this->ax = *PL_markstack_ptr + 1;
00496         --PL_markstack_ptr;
00497         this->mark = PL_stack_base + this->ax - 1;
00498 
00499         ctxstack.push_back(this);
00500     }
00501     Ctx::~Ctx() {
00502         std::vector<Value*>::iterator iter;
00503         for (iter = allocated.begin(); iter != allocated.end(); iter++) {
00504             delete *iter;
00505         }
00506 
00507         PL_stack_sp = PL_stack_base + ax;
00508 
00509         ctxstack.pop_back();
00510     }
00511 
00515     class CurCtx {
00516     public:
00517         static Ctx * get() {
00518             if (ctxstack.size() > 0) {
00519                 return ctxstack[ctxstack.size()-1];
00520             } else {
00521                 Carp::croak("Devel::BindPP: missing context");
00522                 throw; 
00523             }
00524         }
00525     };
00526 
00527     Reference * Reference::new_inc(Value* thing) {
00528         Reference* ref = new Reference(newRV_inc(thing->val));
00529         CurCtx::get()->register_allocated(ref);
00530         return ref;
00531     }
00532 
00533     Reference * Hash::fetch(const char* key) {
00534         
00535         SV ** v = hv_fetch((HV*)this->val, key, strlen(key), 0);
00536         if (v) {
00537             Reference * ref = new Reference(*v);
00538             CurCtx::get()->register_allocated(ref);
00539             return ref;
00540         } else {
00541             return NULL;
00542         }
00543     }
00544     Reference * Array::fetch(I32 key) {
00545         SV ** v = av_fetch((AV*)this->val, key, 0);
00546         if (v) {
00547             Reference * ref = new Reference(*v);
00548             CurCtx::get()->register_allocated(ref);
00549             return ref;
00550         } else {
00551             return NULL;
00552         }
00553     }
00554     Scalar * Array::pop() {
00555         SV* v = av_pop((AV*)this->val);
00556         Scalar *s = new Scalar(v);
00557         CurCtx::get()->register_allocated(s);
00558         return s;
00559     }
00560     Scalar * Array::shift() {
00561         SV* v = av_shift((AV*)this->val);
00562         Scalar *s = new Scalar(v);
00563         CurCtx::get()->register_allocated(s);
00564         return s;
00565     }
00566     Scalar * Array::store(I32 key, Scalar* _v) {
00567         _v->refcnt_inc();
00568         SV** v = av_store((AV*)this->val, key, _v->val);
00569         if (v) {
00570             Reference * ref = new Reference(*v);
00571             CurCtx::get()->register_allocated(ref);
00572             return ref;
00573         } else {
00574             return NULL;
00575         }
00576     }
00577 
00581     class Package {
00582     public:
00583         Package(std::string _pkg) {
00584             pkg = _pkg;
00585             stash = gv_stashpvn(pkg.c_str(), pkg.length(), TRUE);
00586         }
00591         void add_method(const char*name, XSUBADDR_t func, const char *file) {
00592             char * buf = const_cast<char*>( (pkg + "::" + name).c_str() );
00593             newXS(buf, func, const_cast<char*>(file));
00594         }
00599         void add_constant(const char *name, Value * val) {
00600             this->add_constant(name, val->val);
00601         }
00602         void add_constant(const char *name, Value val) {
00603             this->add_constant(name, val.val);
00604         }
00605     protected:
00606         void add_constant(const char *name, SV* val) {
00607             newCONSTSUB(stash, const_cast<char*>(name), val);
00608         }
00609     private:
00610         std::string pkg;
00611         HV * stash;
00612     };
00613 
00617     class BootstrapCtx : public Ctx {
00618     public:
00619         BootstrapCtx() : Ctx() {
00620             xs_version_bootcheck();
00621         }
00622         ~BootstrapCtx() {
00623             PL_stack_base[this->ax] = &PL_sv_yes;
00624             PL_stack_sp = PL_stack_base + this->ax;
00625         }
00626     protected:
00627         
00628         void xs_version_bootcheck() {
00629             SV *_sv;
00630             const char *vn = NULL, *module = SvPV_nolen_const(ST(0));
00631             if (this->arg_len() >= 2) {
00632                 
00633                 _sv = PL_stack_base[ax+1];
00634             } else {
00635                 
00636                 _sv = get_sv(Perl_form(aTHX_ "%s::%s", module,
00637                         vn = "XS_VERSION"), FALSE);
00638                 if (!_sv || !SvOK(_sv))
00639                 _sv = get_sv(Perl_form(aTHX_ "%s::%s", module,
00640                             vn = "VERSION"), FALSE);
00641             }
00642             if (_sv && (!SvOK(_sv) || strNE(XS_VERSION, SvPV_nolen(_sv)))) {
00643                 Perl_croak(aTHX_ "%s object version %s does not match %s%s%s%s %"SVf,
00644                     module, XS_VERSION, 
00645                     vn ? "$" : "", vn ? module : "", vn ? "::" : "",
00646                     vn ? vn : "bootstrap parameter", _sv
00647                 );
00648             }
00649         }
00650     };
00651 
00655     class Code : public Scalar {
00656     public:
00657         Code(SV * _s) : Scalar(_s) { }
00659         void call(Array * args, Array* retval) {
00660             SV **sp = PL_stack_sp;
00661 
00662             push_scope(); 
00663             save_int((int*)&PL_tmps_floor); 
00664             PL_tmps_floor = PL_tmps_ix;
00665 
00666             if (++PL_markstack_ptr == PL_markstack_max) { 
00667                 markstack_grow();
00668             }
00669             *PL_markstack_ptr = (I32)((sp) - PL_stack_base);
00670 
00671             for (int i =0; i < args->len()+1; i++) {
00672                 if (PL_stack_max - sp < 1) { 
00673                     
00674                     sp = stack_grow(sp, sp, 1);
00675                 }
00676                 *++sp = args->pop()->val; 
00677             }
00678             PL_stack_sp = sp; 
00679 
00680             int count = call_sv(this->val, G_ARRAY);
00681 
00682             sp = PL_stack_sp; 
00683 
00684             for (int i=0; i<count; i++) {
00685                 Scalar * s = new Scalar(newSVsv(*sp--));
00686                 CurCtx::get()->register_allocated(s);
00687                 retval->store(i, s);
00688             }
00689 
00690             PL_stack_sp = sp; 
00691             if (PL_tmps_ix > PL_tmps_floor) { 
00692                 free_tmps();
00693             }
00694             pop_scope(); 
00695         }
00697         void call(Array * args, Scalar** retval) {
00698             SV **sp = PL_stack_sp;
00699 
00700             push_scope(); 
00701             save_int((int*)&PL_tmps_floor); 
00702             PL_tmps_floor = PL_tmps_ix;
00703 
00704             if (++PL_markstack_ptr == PL_markstack_max) { 
00705                 markstack_grow();
00706             }
00707             *PL_markstack_ptr = (I32)((sp) - PL_stack_base);
00708 
00709             for (int i =0; i < args->len()+1; i++) {
00710                 if (PL_stack_max - sp < 1) { 
00711                     
00712                     sp = stack_grow(sp, sp, 1);
00713                 }
00714                 *++sp = args->pop()->val; 
00715             }
00716             PL_stack_sp = sp; 
00717 
00718             int count = call_sv(this->val, G_SCALAR);
00719 
00720             sp = PL_stack_sp; 
00721 
00722             if (count != 0) {
00723                 *retval = new Scalar(newSVsv(*sp--));
00724                 CurCtx::get()->register_allocated(*retval);
00725             }
00726 
00727             PL_stack_sp = sp; 
00728             if (PL_tmps_ix > PL_tmps_floor) { 
00729                 free_tmps();
00730             }
00731             pop_scope(); 
00732         }
00733     };
00734 
00738     class Pointer : public Scalar {
00739     public:
00740         Pointer(SV* s) : Scalar(s) { }
00742         Pointer(void* _ptr, const char* klass) : Scalar(sv_newmortal()) {
00743             if (_ptr == NULL) {
00744                 sv_setsv(this->val, &PL_sv_undef);
00745             } else {
00746                 sv_setref_pv(this->val, klass, _ptr);
00747             }
00748         }
00749 
00753         template <class T>
00754         T extract() {
00755             return INT2PTR(T, SvROK(this->val) ? SvIV(SvRV(this->val)) : SvIV(this->val));
00756         }
00757     };
00758 
00763     class FileTest {
00764     public:
00769         static bool is_regular_file(const char * fname) {
00770             Stat_t buf;
00771             int ret = PerlLIO_stat(fname, &buf);
00772             if (ret == 0 && S_ISREG(buf.st_mode)) {
00773                 return true;
00774             } else {
00775                 return false;
00776             }
00777         }
00782         static bool is_dir(const char * fname) {
00783             Stat_t buf;
00784             int ret = PerlLIO_stat(fname, &buf);
00785             if (ret == 0 && S_ISDIR(buf.st_mode)) {
00786                 return true;
00787             } else {
00788                 return false;
00789             }
00790         }
00791     };
00792 
00793     Reference * Value::reference() {
00794         return Reference::new_inc(this);
00795     }
00796 
00797     Str* Scalar::as_str() {
00798         if (SvPOK(this->val)) {
00799             Str * s = new Str(this->val);
00800             CurCtx::get()->register_allocated(s);
00801             return s;
00802         } else {
00803             Perl_croak(aTHX_ "%s: %s is not a string",
00804                 "Devel::BindPP",
00805                 "sv");
00806         }
00807     }
00808     Pointer* Scalar::as_pointer() {
00809         if (SvROK(this->val)) {
00810             Pointer * s = new Pointer(this->val);
00811             CurCtx::get()->register_allocated(s);
00812             return s;
00813         } else {
00814             Perl_croak(aTHX_ "%s: %s is not a pointer",
00815                 "Devel::BindPP",
00816                 "sv");
00817         }
00818     }
00819     Int* Scalar::as_int() {
00820         if (SvIOKp(this->val)) {
00821             Int * s = new Int(this->val);
00822             CurCtx::get()->register_allocated(s);
00823             return s;
00824         } else {
00825             Perl_croak(aTHX_ "%s: %s is not a int",
00826                 "Devel::BindPP",
00827                 "sv");
00828         }
00829     }
00830     UInt* Scalar::as_uint() {
00831         if (SvIOK(this->val)) {
00832             UInt * s = new UInt(this->val);
00833             CurCtx::get()->register_allocated(s);
00834             return s;
00835         } else {
00836             Perl_croak(aTHX_ "%s: %s is not a uint",
00837                 "Devel::BindPP",
00838                 "sv");
00839         }
00840     }
00841     Double* Scalar::as_double() {
00842         if (SvNOK(this->val)) {
00843             Double * s = new Double(this->val);
00844             CurCtx::get()->register_allocated(s);
00845             return s;
00846         } else {
00847             Perl_croak(aTHX_ "%s: %s is not a double",
00848                 "Devel::BindPP",
00849                 "sv");
00850         }
00851     }
00852     Reference* Scalar::as_ref() {
00853         if (SvROK(this->val)) {
00854             Reference * obj = new Reference(this->val);
00855             CurCtx::get()->register_allocated(obj);
00856             return obj;
00857         } else {
00858             Perl_croak(aTHX_ "%s: %s is not a reference",
00859                 "Devel::BindPP",
00860                 "sv");
00861         }
00862     }
00863     
00864 
00865 
00866 
00867 
00868 
00869 
00870 
00871 
00872     Hash * Reference::as_hash() {
00873         if (SvROK(this->val) && SvTYPE(SvRV(this->val))==SVt_PVHV) {
00874             HV* h = (HV*)SvRV(this->val);
00875             Hash * hobj = new Hash(h);
00876             CurCtx::get()->register_allocated(hobj);
00877             return hobj;
00878         } else {
00879             Perl_croak(aTHX_ "%s: %s is not a hash reference",
00880                 "Devel::BindPP",
00881                 "hv");
00882         }
00883     }
00884     Array * Reference::as_array() {
00885         SV* v = this->val;
00886         if (SvROK(v) && SvTYPE(SvRV(v))==SVt_PVAV) {
00887             AV* a = (AV*)SvRV(v);
00888             Array * obj = new Array(a);
00889             CurCtx::get()->register_allocated(obj);
00890             return obj;
00891         } else {
00892             Perl_croak(aTHX_ "%s: %s is not a array reference",
00893                 "Devel::BindPP",
00894                 "av");
00895         }
00896     }
00897     Scalar * Reference::as_scalar() {
00898         SV* v = this->val;
00899         if (v && SvROK(v)) {
00900             SV* a = (SV*)SvRV(v);
00901             Scalar * obj = new Scalar(a);
00902             CurCtx::get()->register_allocated(obj);
00903             return obj;
00904         } else {
00905             Perl_croak(aTHX_ "%s: %s is not a array reference",
00906                 "Devel::BindPP",
00907                 "sv");
00908         }
00909     }
00910     Code * Reference::as_code() {
00911         SV* v = this->val;
00912         if (v && SvROK(v)) {
00913             SV* a = (SV*)SvRV(v);
00914             Code * obj = new Code(a);
00915             CurCtx::get()->register_allocated(obj);
00916             return obj;
00917         } else {
00918             Perl_croak(aTHX_ "%s: %s is not a array reference",
00919                 "Devel::BindPP",
00920                 "sv");
00921         }
00922     }
00923 
00924     Reference* Hash::del(const char*key, I32 klen) {
00925         Reference * ref = new Reference(hv_delete((HV*)this->val, key, klen, 0));
00926         CurCtx::get()->register_allocated(ref);
00927         return ref;
00928     }
00929     void Hash::store(const char*key, I32 klen, Scalar*value) {
00930         value->refcnt_inc();
00931         hv_store((HV*)this->val, key, klen, value->val, 0);
00932     }
00933     Scalar* Hash::scalar() {
00934         Scalar*s = new Scalar(hv_scalar((HV*)this->val));
00935         CurCtx::get()->register_allocated(s);
00936         return s;
00937     }
00938     void Hash::undef() {
00939         hv_undef((HV*)this->val);
00940     }
00941     void Hash::clear() {
00942         hv_clear((HV*)this->val);
00943     }
00944     Boolean* Boolean::yes() {
00945         Boolean* s = new Boolean(true);
00946         CurCtx::get()->register_allocated(s);
00947         return s;
00948     }
00949     Boolean* Boolean::no() {
00950         Boolean* s = new Boolean(false);
00951         CurCtx::get()->register_allocated(s);
00952         return s;
00953     }
00954 };