Added __CLASS__ keyword, which yields the runtime class name of the i…

…nvoking instance

class.c

@@ -1059,6 +1059,29 @@ Perl_class_add_ADJUST(pTHX_ HV *stash, CV *cv)
     av_push(aux->xhv_class_adjust_blocks, (SV *)cv);
 }
 
+OP *
+Perl_ck_classname(pTHX_ OP *o)
+{
+    if(!CvIsMETHOD(PL_compcv))
+        croak("Cannot use __CLASS__ outside of a method or field initializer expression");
+
+    return o;
+}
+
+PP(pp_classname)
+{
+    dSP;
+
+    SV *self = PAD_SVl(PADIX_SELF);
+    assert(SvTYPE(SvRV(self)) == SVt_PVOBJ);
+
+    EXTEND(SP, 1);
+    PUSHs(sv_newmortal());
+    sv_ref(*SP, SvRV(self), true);
+
+    RETURN;
+}
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */

embed.h

@@ -1183,6 +1183,7 @@
 #     define ck_anoncode(a)                     Perl_ck_anoncode(aTHX_ a)
 #     define ck_backtick(a)                     Perl_ck_backtick(aTHX_ a)
 #     define ck_bitop(a)                        Perl_ck_bitop(aTHX_ a)
+#     define ck_classname(a)                    Perl_ck_classname(aTHX_ a)
 #     define ck_cmp(a)                          Perl_ck_cmp(aTHX_ a)
 #     define ck_concat(a)                       Perl_ck_concat(aTHX_ a)
 #     define ck_defined(a)                      Perl_ck_defined(aTHX_ a)

ext/Opcode/Opcode.pm

@@ -567,7 +567,7 @@ This tag holds opcodes related to loading modules and getting information
 about calling environment and args.
 
     require dofile 
-    caller runcv
+    caller runcv classname
 
 =item :still_to_be_decided
 

ext/Pod-Functions/t/Functions.t

@@ -133,8 +133,8 @@ Keywords related to Perl modules:
      do, import, no, package, require, use
 
 Keywords related to classes and object-orientation:
-     bless, class, dbmclose, dbmopen, field, method, package,
-     ref, tie, tied, untie, use
+     __CLASS__, bless, class, dbmclose, dbmopen, field, method,
+     package, ref, tie, tied, untie, use
 
 Low-level socket functions:
      accept, bind, connect, getpeername, getsockname,