#include "EXTERN.h"

#include "perl.h"

#include "XSUB.h"

#include "ppport.h"

#ifndef CvISXSUB

#   define CvISXSUB(cv) CvXSUB(cv)

#endif

/*

get_code_info:

  Pass in a coderef, returns:

  [ $pkg_name, $coderef_name ] ie:

  [ 'Foo::Bar', 'new' ]

*/

MODULE = Sub::Identify   PACKAGE = Sub::Identify

PROTOTYPES: ENABLE

void

get_code_info(coderef)

    SV* coderef

    PREINIT:

        char* name;

        char* pkg;

    PPCODE:

        if (SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV) {

            coderef = SvRV(coderef);

            if (CvGV(coderef)) {

                name = GvNAME( CvGV(coderef) );

                pkg = HvNAME( GvSTASH(CvGV(coderef)) );

                EXTEND(SP, 2);

                PUSHs(sv_2mortal(newSVpvn(pkg, strlen(pkg))));

                PUSHs(sv_2mortal(newSVpvn(name, strlen(name))));

            }

            else {

                /* sub is being compiled: bail out and return nothing. */

            }

        }

void

get_code_location(coderef)

    SV* coderef

    PREINIT:

        char* file;

        line_t line;

    PPCODE:

        if (SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV) {

            coderef = SvRV(coderef);

            if (CvSTART(coderef) && !CvISXSUB(coderef)) {

                file = CvFILE(coderef);

                line = CopLINE((const COP*)CvSTART(coderef));

                EXTEND(SP, 2);

                PUSHs(sv_2mortal(newSVpvn(file, strlen(file))));

                PUSHs(sv_2mortal(newSViv(line)));

            }

        }

#if PERL_VERSION >= 16

bool

is_sub_constant(coderef)

    SV* coderef

    CODE:

        if (SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV) {

            coderef = SvRV(coderef);

            RETVAL = CvPROTO(coderef) && CvPROTOLEN(coderef) == 0 && CvCONST(coderef);

        }

        else

            RETVAL = 0;

    OUTPUT:

        RETVAL

#endif