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 };