00001
00008 #include <string>
00009 #include <vector>
00010
00011
00012
00013
00014
00015
00016
00017
00018 extern "C" {
00019 #include "EXTERN.h"
00020 #include "perl.h"
00021 #include "XSUB.h"
00022 #include "ppport.h"
00023 #include <cstdarg>
00024 };
00025
00026 namespace pl {
00027 class Str;
00028 class UInt;
00029 class Int;
00030 class Double;
00031 class Pointer;
00032 class Reference;
00033 class Hash;
00034 class Array;
00035 class Package;
00036 class Code;
00037 class Ctx;
00038 class Scalar;
00039
00041 class IO {
00042 public:
00044 static PerlIO* stderr() {
00045 return PerlIO_stderr();
00046 }
00048 static PerlIO* stdout() {
00049 return PerlIO_stdout();
00050 }
00052 static void printf(const char *format, ...) {
00053 va_list args;
00054 va_start(args, format);
00055 PerlIO_vprintf(IO::stdout(), format, args);
00056 va_end(args);
00057 }
00059 static void printf(PerlIO* io, const char *format, ...) {
00060 va_list args;
00061 va_start(args, format);
00062 PerlIO_vprintf(io, format, args);
00063 va_end(args);
00064 }
00065 };
00066
00070 class Carp {
00071 public:
00072 static void croak(const char * format, ...) {
00073 va_list args;
00074 va_start(args, format);
00075 Perl_vcroak(aTHX_ format, &args);
00076 va_end(args);
00077 }
00078 static void warn(const char * format, ...) {
00079 va_list args;
00080 va_start(args, format);
00081 Perl_vwarn(aTHX_ format, &args);
00082 va_end(args);
00083 }
00084 };
00085
00089 std::vector<Ctx*> ctxstack;
00090 class CurCtx {
00091 public:
00092 static Ctx * get() {
00093 if (ctxstack.size() > 0) {
00094 return ctxstack[ctxstack.size()-1];
00095 } else {
00096 Carp::croak("Devel::BindPP: missing context");
00097 throw;
00098 }
00099 }
00100 };
00101
00105 class Value {
00106 friend class Ctx;
00107 friend class Reference;
00108 friend class Array;
00109 friend class Perl;
00110 friend class Hash;
00111 friend class Package;
00112 friend class Code;
00113
00114 public:
00119 void dump() {
00120 sv_dump(this->val);
00121 }
00126 void refcnt_inc() {
00127 SvREFCNT_inc_simple_void(this->val);
00128 }
00133 void refcnt_dec() {
00134 SvREFCNT_dec(this->val);
00135 }
00139 int refcnt() {
00140 return SvREFCNT(this->val);
00141 }
00142 bool is_true() {
00143 return SvTRUE(this->val);
00144 }
00148 Reference* reference();
00149 ~Value() {
00150 }
00151 protected:
00152 SV* val;
00153 Value() { }
00154 Value(SV* _v) {
00155 this->val = _v;
00156 }
00157 };
00158
00162 class Scalar : public Value {
00163 friend class Ctx;
00164 friend class Reference;
00165 friend class Array;
00166 friend class Perl;
00167 friend class Hash;
00168 friend class Package;
00169 friend class Code;
00170
00171 public:
00176 Scalar * mortal() {
00177 sv_2mortal(this->val);
00178 return this;
00179 }
00183 SV * serialize() {
00184 return val;
00185 }
00189 Str* as_str();
00193 Int* as_int();
00197 UInt* as_uint();
00201 Double* as_double();
00205 Pointer* as_pointer();
00209 Reference* as_ref();
00210 Scalar * clone () {
00211 return Scalar::create(newSVsv(this->val));
00212 }
00213
00214 static Scalar *to_perl(const char* s) {
00215 return Scalar::create(newSVpv(s, strlen(s)));
00216 }
00217 static Scalar *to_perl(unsigned int v) {
00218 return Scalar::create(newSVuv(v));
00219 }
00220 static Scalar *to_perl(int v) {
00221 return Scalar::create(newSViv(v));
00222 }
00223 static Scalar *to_perl(I32 v) {
00224 return Scalar::create(newSViv(v));
00225 }
00226 static Scalar *to_perl(double v) {
00227 return Scalar::create(newSVnv(v));
00228 }
00229 static Scalar *to_perl(Scalar * v) {
00230 if (v && v->val) {
00231 return Scalar::create(v->val);
00232 } else {
00233 return Scalar::create(&PL_sv_undef);
00234 }
00235 }
00236 static Scalar *to_perl(std::string& v) {
00237 return Scalar::create(newSVpv(v.c_str(), v.length()));
00238 }
00239 static Scalar *to_perl(bool b) {
00240 return Scalar::create(b ? &PL_sv_yes : &PL_sv_no);
00241 }
00242 protected:
00243 Scalar(SV* _v) : Value(_v) { }
00244 static Scalar * create(SV* _v);
00245 };
00246
00250 class Boolean : public Scalar {
00251 public:
00252 Boolean(bool b) : Scalar(b ? &PL_sv_yes : &PL_sv_no) { }
00257 static Boolean* yes();
00262 static Boolean* no();
00263 };
00267 class Int : public Scalar {
00268 friend class Scalar;
00269 public:
00273 int to_c() {
00274 return SvIV(this->val);
00275 }
00276 protected:
00277 Int(SV* _s) : Scalar(_s) { }
00278 };
00282 class UInt : public Scalar {
00283 friend class Scalar;
00284 public:
00285 UInt(unsigned int _i) : Scalar(newSVuv(_i)) { }
00289 unsigned int to_c() {
00290 return SvUV(this->val);
00291 }
00292 protected:
00293 UInt(SV* _s) : Scalar(_s) { }
00294 };
00298 class Double : public Scalar {
00299 friend class Scalar;
00300 public:
00301 Double(double _i) : Scalar(newSVnv(_i)) { }
00305 double to_c() {
00306 return SvNV(this->val);
00307 }
00308 protected:
00309 Double(SV* _s) : Scalar(_s) { }
00310 };
00314 class Str : public Scalar {
00315 friend class Scalar;
00316 public:
00317 Str(std::string & _s) : Scalar(newSVpv(_s.c_str(), _s.length())) { }
00318 Str(const char* _s) : Scalar(newSVpv(_s, strlen(_s))) { }
00319 Str(const char* _s, int _n) : Scalar(newSVpv(_s, _n)) { }
00323 const char* to_c() {
00324 return SvPV_nolen(this->val);
00325 }
00329 void concat(const char* s, I32 len) {
00330 sv_catpvn(this->val, s, len);
00331 }
00332 void concat(const char* s) {
00333 sv_catpv(this->val, s);
00334 }
00335 void concat(Str* s) {
00336 sv_catsv(this->val, s->val);
00337 }
00339 int length() {
00340 return sv_len(this->val);
00341 }
00342 protected:
00343 Str(SV* _s) : Scalar(_s) { }
00344 };
00345
00349 class Reference : public Scalar {
00350 friend class Scalar;
00351 friend class Hash;
00352 friend class Array;
00353 public:
00357 static Reference * new_inc(Value* thing);
00359 void bless(const char *pkg) {
00360 HV * stash = gv_stashpv(pkg, TRUE);
00361 sv_bless(this->val, stash);
00362 }
00364 Hash * as_hash();
00366 Array * as_array();
00368 Scalar * as_scalar();
00370 Code* as_code();
00374 bool is_object() {
00375 return sv_isobject(this->val);
00376 }
00377 protected:
00378 Reference(SV*v) : Scalar(v) { }
00379 };
00380
00384 class Hash : public Value {
00385 friend class Reference;
00386 public:
00387 Hash() : Value((SV*)newHV()) { }
00389 Reference * fetch(const char *key);
00391 bool exists(const char*key) {
00392 return this->exists(key, strlen(key));
00393 }
00395 bool exists(const char*key, I32 klen) {
00396 return hv_exists((HV*)this->val, key, klen);
00397 }
00399 Reference* del(const char*key) {
00400 return this->del(key, strlen(key));
00401 }
00403 Reference* del(const char*key, I32 klen);
00404
00406 template <class T>
00407 void store(const char*key, T value) {
00408 this->store(key, strlen(key), Scalar::to_perl(value));
00409 }
00411 void store(const char*key, I32 klen, Scalar*value);
00413 Scalar* scalar();
00415 void undef();
00417 void clear();
00418 protected:
00419 Hash(HV* _h) : Value((SV*)_h) { }
00420 };
00421
00425 class Array : public Value {
00426 friend class Reference;
00427 public:
00428 Array() : Value((SV*)newAV()) { }
00430 void push(Scalar* s) {
00431 s->refcnt_inc();
00432 av_push((AV*)this->val, s->val);
00433 }
00434 template <class T>
00435 void push(T v) {
00436 Scalar * s = Scalar::to_perl(v);
00437 s->refcnt_inc();
00438 av_push((AV*)this->val, s->val);
00439 }
00444 void unshift(Int &i) {
00445 this->unshift(i.to_c());
00446 }
00447 void unshift(I32 i) {
00448 av_unshift((AV*)this->val, i);
00449 }
00451 Scalar * pop();
00453 Scalar * shift();
00455 Reference * fetch(I32 key);
00456
00458 I32 len() {
00459 return av_len((AV*)this->val);
00460 }
00462 U32 size() {
00463 return this->len() + 1;
00464 }
00465
00467 template <class T>
00468 Scalar * store(I32 key, T v);
00470 void clear() {
00471 av_clear((AV*)this->val);
00472 }
00474 void undef() {
00475 av_undef((AV*)this->val);
00476 }
00478 void extend(I32 n) {
00479 av_extend((AV*)this->val, n);
00480 }
00481 protected:
00482 Array(AV* _a) : Value((SV*)_a) { }
00483 };
00484
00488 class Ctx {
00489 public:
00490 Ctx();
00491 Ctx(int arg_cnt);
00492 ~Ctx();
00494 I32 arg_len() {
00495 return (I32)(PL_stack_sp - mark);
00496 }
00498 Scalar* arg(int n) {
00499 Scalar*s = new Scalar(fetch_stack(n));
00500 this->register_allocated(s);
00501 return s;
00502 }
00504 template <class T>
00505 void ret(T n) {
00506 Scalar * s = Scalar::to_perl(n);
00507 this->ret(0, s->val);
00508 }
00509 template <class T>
00510 void ret(int n, T v) {
00511 return this->ret(n, Scalar::to_perl(v));
00512 }
00514 bool wantarray() {
00515 return GIMME_V & G_ARRAY ? true : false;
00516 }
00518 void ret(Array* ary) {
00519 unsigned int size = ary->size();
00520 if (size != 0) {
00521 SV** sp = PL_stack_sp;
00522 if ((unsigned int)(PL_stack_max - sp) < size) {
00523 sp = stack_grow(sp, sp, size);
00524 }
00525
00526 for (unsigned int i=0; i < size; ++i) {
00527 Scalar * s = ary->fetch(i);
00528 PL_stack_base[ax++] = s->val;
00529 }
00530 ax--;
00531 } else {
00532 this->return_undef();
00533 }
00534 }
00536 void return_true() {
00537 this->ret(0, &PL_sv_yes);
00538 }
00540 void return_undef() {
00541 this->ret(0, &PL_sv_undef);
00542 }
00548 void register_allocated(Value* v) {
00549 allocated.push_back(v);
00550 }
00551 protected:
00556 SV* fetch_stack(int n) {
00557 return PL_stack_base[this->ax + n];
00558 }
00559 void ret(int n, SV* s) {
00560 PL_stack_base[ax + n] = s;
00561 }
00562 void initialize();
00563 I32 ax;
00564 SV ** mark;
00565 std::vector<Value*> allocated;
00566 };
00567 Ctx::Ctx() {
00568 this->initialize();
00569 }
00570 Ctx::Ctx(int arg_cnt) {
00571 this->initialize();
00572
00573 int got = arg_len();
00574 if (arg_cnt != got) {
00575 Carp::croak("This method requires %d arguments, but %d", arg_cnt, got);
00576 }
00577 }
00578 void Ctx::initialize() {
00579
00580 this->ax = *PL_markstack_ptr + 1;
00581 --PL_markstack_ptr;
00582 this->mark = PL_stack_base + this->ax - 1;
00583
00584 ctxstack.push_back(this);
00585 }
00586 Ctx::~Ctx() {
00587 std::vector<Value*>::iterator iter;
00588 for (iter = allocated.begin(); iter != allocated.end(); iter++) {
00589 delete *iter;
00590 }
00591
00592 PL_stack_sp = PL_stack_base + ax;
00593
00594 ctxstack.pop_back();
00595 }
00596
00597 Reference * Reference::new_inc(Value* thing) {
00598 SV * v = newRV_inc(thing->val);
00599 Reference * ref = new Reference(v);
00600 CurCtx::get()->register_allocated(ref);
00601 return ref;
00602 }
00603
00604 Reference * Hash::fetch(const char* key) {
00605
00606 SV ** v = hv_fetch((HV*)this->val, key, strlen(key), 0);
00607 if (v) {
00608 Reference * ref = new Reference(*v);
00609 CurCtx::get()->register_allocated(ref);
00610 return ref;
00611 } else {
00612 return NULL;
00613 }
00614 }
00615 Reference * Array::fetch(I32 key) {
00616 SV ** v = av_fetch((AV*)this->val, key, 0);
00617 if (v) {
00618 Reference * ref = new Reference(*v);
00619 CurCtx::get()->register_allocated(ref);
00620 return ref;
00621 } else {
00622 return NULL;
00623 }
00624 }
00625 Scalar * Array::pop() {
00626 SV* v = av_pop((AV*)this->val);
00627 return Scalar::create(v);
00628 }
00629 Scalar * Array::shift() {
00630 SV* v = av_shift((AV*)this->val);
00631 return Scalar::create(v);
00632 }
00633 template <class T>
00634 Scalar * Array::store(I32 key, T arg) {
00635 Scalar * _v = Scalar::to_perl(arg);
00636 _v->refcnt_inc();
00637 SV** v = av_store((AV*)this->val, key, _v->val);
00638 if (v) {
00639 Reference * ref = new Reference(*v);
00640 CurCtx::get()->register_allocated(ref);
00641 return ref;
00642 } else {
00643 return NULL;
00644 }
00645 }
00646
00650 class Package {
00651 public:
00652 Package(std::string _pkg, const char *_file) {
00653 this->pkg = _pkg;
00654 this->file = _file;
00655 stash = gv_stashpvn(pkg.c_str(), pkg.length(), TRUE);
00656 }
00661 void add_method(const char*name, XSUBADDR_t func) {
00662 char * buf = const_cast<char*>( (pkg + "::" + name).c_str() );
00663 newXS(buf, func, const_cast<char*>(this->file));
00664 }
00669 void add_constant(const char *name, Value * val) {
00670 this->add_constant(name, val->val);
00671 }
00672
00673 template <class T>
00674 void add_constant(const char *name, T val) {
00675 Scalar * s = Scalar::to_perl(val);
00676 this->add_constant(name, s->serialize());
00677 }
00678 protected:
00679 void add_constant(const char *name, SV* val) {
00680 newCONSTSUB(stash, const_cast<char*>(name), val);
00681 }
00682 private:
00683 std::string pkg;
00684 HV * stash;
00685 const char * file;
00686 };
00687
00691 class BootstrapCtx : public Ctx {
00692 public:
00693 BootstrapCtx() : Ctx() {
00694 xs_version_bootcheck();
00695 }
00696 ~BootstrapCtx() {
00697 PL_stack_base[this->ax] = &PL_sv_yes;
00698 PL_stack_sp = PL_stack_base + this->ax;
00699 }
00700 protected:
00701
00702 void xs_version_bootcheck() {
00703 SV *_sv;
00704 const char *vn = NULL, *module = SvPV_nolen_const(ST(0));
00705 if (this->arg_len() >= 2) {
00706
00707 _sv = PL_stack_base[ax+1];
00708 } else {
00709
00710 _sv = get_sv(Perl_form(aTHX_ "%s::%s", module,
00711 vn = "XS_VERSION"), FALSE);
00712 if (!_sv || !SvOK(_sv))
00713 _sv = get_sv(Perl_form(aTHX_ "%s::%s", module,
00714 vn = "VERSION"), FALSE);
00715 }
00716 if (_sv && (!SvOK(_sv) || strNE(XS_VERSION, SvPV_nolen(_sv)))) {
00717 Perl_croak(aTHX_ "%s object version %s does not match %s%s%s%s %"SVf,
00718 module, XS_VERSION,
00719 vn ? "$" : "", vn ? module : "", vn ? "::" : "",
00720 vn ? vn : "bootstrap parameter", _sv
00721 );
00722 }
00723 }
00724 };
00725
00729 class Code : public Scalar {
00730 public:
00731 Code(SV * _s) : Scalar(_s) { }
00733 void call(Array * args, Array* retval) {
00734 SV **sp = PL_stack_sp;
00735
00736 push_scope();
00737 save_int((int*)&PL_tmps_floor);
00738 PL_tmps_floor = PL_tmps_ix;
00739
00740 if (++PL_markstack_ptr == PL_markstack_max) {
00741 markstack_grow();
00742 }
00743 *PL_markstack_ptr = (I32)((sp) - PL_stack_base);
00744
00745 for (int i =0; i < args->len()+1; i++) {
00746 if (PL_stack_max - sp < 1) {
00747
00748 sp = stack_grow(sp, sp, 1);
00749 }
00750 *++sp = args->pop()->val;
00751 }
00752 PL_stack_sp = sp;
00753
00754 int count = call_sv(this->val, G_ARRAY);
00755
00756 sp = PL_stack_sp;
00757
00758 for (int i=0; i<count; i++) {
00759 Scalar * s = Scalar::create(newSVsv(*sp--));
00760 retval->store(i, s);
00761 }
00762
00763 PL_stack_sp = sp;
00764 if (PL_tmps_ix > PL_tmps_floor) {
00765 free_tmps();
00766 }
00767 pop_scope();
00768 }
00770 void call(Array * args, Scalar** retval) {
00771 SV **sp = PL_stack_sp;
00772
00773 push_scope();
00774 save_int((int*)&PL_tmps_floor);
00775 PL_tmps_floor = PL_tmps_ix;
00776
00777 if (++PL_markstack_ptr == PL_markstack_max) {
00778 markstack_grow();
00779 }
00780 *PL_markstack_ptr = (I32)((sp) - PL_stack_base);
00781
00782 for (int i =0; i < args->len()+1; i++) {
00783 if (PL_stack_max - sp < 1) {
00784
00785 sp = stack_grow(sp, sp, 1);
00786 }
00787 *++sp = args->pop()->val;
00788 }
00789 PL_stack_sp = sp;
00790
00791 int count = call_sv(this->val, G_SCALAR);
00792
00793 sp = PL_stack_sp;
00794
00795 if (count != 0) {
00796 *retval = Scalar::create(newSVsv(*sp--));
00797 }
00798
00799 PL_stack_sp = sp;
00800 if (PL_tmps_ix > PL_tmps_floor) {
00801 free_tmps();
00802 }
00803 pop_scope();
00804 }
00805 };
00806
00810 class Pointer : public Scalar {
00811 public:
00812 Pointer(SV* s) : Scalar(s) { }
00814 Pointer(void* _ptr, const char* klass) : Scalar(sv_newmortal()) {
00815 if (_ptr == NULL) {
00816 sv_setsv(this->val, &PL_sv_undef);
00817 } else {
00818 sv_setref_pv(this->val, klass, _ptr);
00819 }
00820 }
00821
00825 template <class T>
00826 T extract() {
00827 return INT2PTR(T, SvROK(this->val) ? SvIV(SvRV(this->val)) : SvIV(this->val));
00828 }
00829 };
00830
00835 class FileTest {
00836 public:
00841 static bool is_regular_file(const char * fname) {
00842 Stat_t buf;
00843 int ret = PerlLIO_stat(fname, &buf);
00844 if (ret == 0 && S_ISREG(buf.st_mode)) {
00845 return true;
00846 } else {
00847 return false;
00848 }
00849 }
00854 static bool is_dir(const char * fname) {
00855 Stat_t buf;
00856 int ret = PerlLIO_stat(fname, &buf);
00857 if (ret == 0 && S_ISDIR(buf.st_mode)) {
00858 return true;
00859 } else {
00860 return false;
00861 }
00862 }
00863 };
00864
00865 Reference * Value::reference() {
00866 return Reference::new_inc(this);
00867 }
00868
00869 Str* Scalar::as_str() {
00870 if (SvPOK(this->val)) {
00871 Str * s = new Str(this->val);
00872 CurCtx::get()->register_allocated(s);
00873 return s;
00874 } else {
00875 Perl_croak(aTHX_ "%s: %s is not a string",
00876 "Devel::BindPP",
00877 "sv");
00878 }
00879 }
00880 Pointer* Scalar::as_pointer() {
00881 if (SvROK(this->val)) {
00882 Pointer * s = new Pointer(this->val);
00883 CurCtx::get()->register_allocated(s);
00884 return s;
00885 } else {
00886 Perl_croak(aTHX_ "%s: %s is not a pointer",
00887 "Devel::BindPP",
00888 "sv");
00889 }
00890 }
00891 Int* Scalar::as_int() {
00892 if (SvIOKp(this->val)) {
00893 Int * s = new Int(this->val);
00894 CurCtx::get()->register_allocated(s);
00895 return s;
00896 } else {
00897 Perl_croak(aTHX_ "%s: %s is not a int",
00898 "Devel::BindPP",
00899 "sv");
00900 }
00901 }
00902 UInt* Scalar::as_uint() {
00903 if (SvIOK(this->val)) {
00904 UInt * s = new UInt(this->val);
00905 CurCtx::get()->register_allocated(s);
00906 return s;
00907 } else {
00908 Perl_croak(aTHX_ "%s: %s is not a uint",
00909 "Devel::BindPP",
00910 "sv");
00911 }
00912 }
00913 Double* Scalar::as_double() {
00914 if (SvNOK(this->val)) {
00915 Double * s = new Double(this->val);
00916 CurCtx::get()->register_allocated(s);
00917 return s;
00918 } else {
00919 Perl_croak(aTHX_ "%s: %s is not a double",
00920 "Devel::BindPP",
00921 "sv");
00922 }
00923 }
00924 Reference* Scalar::as_ref() {
00925 if (SvROK(this->val)) {
00926 Reference * obj = new Reference(this->val);
00927 CurCtx::get()->register_allocated(obj);
00928 return obj;
00929 } else {
00930 Perl_croak(aTHX_ "%s: %s is not a reference",
00931 "Devel::BindPP",
00932 "sv");
00933 }
00934 }
00935
00936
00937
00938
00939
00940
00941
00942
00943
00944 Hash * Reference::as_hash() {
00945 if (SvROK(this->val) && SvTYPE(SvRV(this->val))==SVt_PVHV) {
00946 HV* h = (HV*)SvRV(this->val);
00947 Hash * hobj = new Hash(h);
00948 CurCtx::get()->register_allocated(hobj);
00949 return hobj;
00950 } else {
00951 Perl_croak(aTHX_ "%s: %s is not a hash reference",
00952 "Devel::BindPP",
00953 "hv");
00954 }
00955 }
00956 Array * Reference::as_array() {
00957 SV* v = this->val;
00958 if (SvROK(v) && SvTYPE(SvRV(v))==SVt_PVAV) {
00959 AV* a = (AV*)SvRV(v);
00960 Array * obj = new Array(a);
00961 CurCtx::get()->register_allocated(obj);
00962 return obj;
00963 } else {
00964 Perl_croak(aTHX_ "%s: %s is not a array reference",
00965 "Devel::BindPP",
00966 "av");
00967 }
00968 }
00969 Scalar * Reference::as_scalar() {
00970 SV* v = this->val;
00971 if (v && SvROK(v)) {
00972 SV* a = (SV*)SvRV(v);
00973 Scalar * obj = new Scalar(a);
00974 CurCtx::get()->register_allocated(obj);
00975 return obj;
00976 } else {
00977 Perl_croak(aTHX_ "%s: %s is not a array reference",
00978 "Devel::BindPP",
00979 "sv");
00980 }
00981 }
00982 Code * Reference::as_code() {
00983 SV* v = this->val;
00984 if (v && SvROK(v)) {
00985 SV* a = (SV*)SvRV(v);
00986 Code * obj = new Code(a);
00987 CurCtx::get()->register_allocated(obj);
00988 return obj;
00989 } else {
00990 Perl_croak(aTHX_ "%s: %s is not a array reference",
00991 "Devel::BindPP",
00992 "sv");
00993 }
00994 }
00995
00996 Reference* Hash::del(const char*key, I32 klen) {
00997 Reference * ref = new Reference(hv_delete((HV*)this->val, key, klen, 0));
00998 CurCtx::get()->register_allocated(ref);
00999 return ref;
01000 }
01001 void Hash::store(const char*key, I32 klen, Scalar*value) {
01002 value->refcnt_inc();
01003 hv_store((HV*)this->val, key, klen, value->val, 0);
01004 }
01005 Scalar* Hash::scalar() {
01006 Scalar*s = new Scalar(hv_scalar((HV*)this->val));
01007 CurCtx::get()->register_allocated(s);
01008 return s;
01009 }
01010 void Hash::undef() {
01011 hv_undef((HV*)this->val);
01012 }
01013 void Hash::clear() {
01014 hv_clear((HV*)this->val);
01015 }
01016 Boolean* Boolean::yes() {
01017 Boolean* s = new Boolean(true);
01018 CurCtx::get()->register_allocated(s);
01019 return s;
01020 }
01021 Boolean* Boolean::no() {
01022 Boolean* s = new Boolean(false);
01023 CurCtx::get()->register_allocated(s);
01024 return s;
01025 }
01026
01027 Scalar* Scalar::create(SV* s) {
01028 Scalar * v = new Scalar(s);
01029 CurCtx::get()->register_allocated(v);
01030 return v;
01031 }
01032 };