/* Copyright (c) 1997-2004			 -*- C -*-
   Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
   http://www.math.tu-berlin.de/polymake,  mailto:polymake@math.tu-berlin.de

   This program is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by the
   Free Software Foundation; either version 2, or (at your option) any
   later version: http://www.gnu.org/licenses/gpl.txt.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.
*/

#ident "$Project: polymake $$Id: namespaces.xs,v 1.8 2004/11/25 13:07:22 gawrilow Exp $"

#include "Ext.h"

#define DebugNamespaces 0

struct ToRestore;

typedef OP* (*pp_fun_ptr)(pTHX);
typedef OP* (*ck_fun_ptr)(pTHX_ OP*);
typedef void (*recover_fun_ptr)(pTHX_ struct ToRestore*);

typedef struct ToRestore {
   ANY savearea[3];
   pp_fun_ptr gv, gvsv, rv2gv, aelemfast, require, entereval;
   ck_fun_ptr ck_const;
   CV *db_db;
   recover_fun_ptr recover;
   I32 hints, import_from_level;
} ToRestore;

static
void (*save_ptrs)(pTHX_ ToRestore *to_restore);

static
void (*catch_ptrs)(pTHX_ ToRestore *to_restore);

static
void (*reset_ptrs)(pTHX);

static
void undo(pTHX_ void *x)
{
   ANY *s=PL_savestack+PL_savestack_ix;
   ToRestore *to_restore=(ToRestore*)x;
   (*to_restore->recover)(aTHX_ to_restore);
   *s++=to_restore->savearea[0];
   *s++=to_restore->savearea[1];
   *s  =to_restore->savearea[2];
#if DebugNamespaces
   fprintf(stderr, "%s executed in cx=%d scope=%d savesp=%d =>%s\n", to_restore->recover==catch_ptrs ? "catch" : "restore", cxstack_ix, PL_scopestack_ix, PL_savestack_ix, PL_check[OP_CONST]==&Perl_ck_svconst ? "off" : "ON"); fflush(stderr);
#endif
   Safefree(to_restore);
   PL_savestack_ix+=3;
}

static
ToRestore* newToRestore(pTHX_ I32 where_ix, I32 *is_new)
{
   ToRestore *to_restore;
   I32 cur_ix=PL_savestack_ix;
   ANY *where=PL_savestack+where_ix;
   if (where[0].any_dxptr == &undo && where[2].any_i32 == SAVEt_DESTRUCTOR_X) {
      *is_new=FALSE;
      to_restore=(ToRestore*)where[1].any_ptr;
   } else {
      *is_new=TRUE;
      New(0, to_restore, 1, ToRestore);
      to_restore->savearea[0]=*where++;
      to_restore->savearea[1]=*where++;
      to_restore->savearea[2]=*where;
      PL_savestack_ix=where_ix;
      save_destructor_x(&undo, to_restore);
      PL_savestack_ix=cur_ix;
   }
   return to_restore;
}

static
void removeToRestore(pTHX_ I32 where_ix)
{
   ANY *where=PL_savestack+where_ix;
   if (where[0].any_dxptr == &undo && where[2].any_i32 == SAVEt_DESTRUCTOR_X) {
      ToRestore *to_restore=(ToRestore*)where[1].any_ptr;
      *where++=to_restore->savearea[0];
      *where++=to_restore->savearea[1];
      *where  =to_restore->savearea[2];
      Safefree(to_restore);
   }
}

static
void register_undo(pTHX)
{
   I32 cix=cxstack_ix;
   /* only if called via 'use' and not from the main script */
   if (cix>=3 && CxTYPE(cxstack+cix) == CXt_SUB && CvSPECIAL(cxstack[cix].blk_sub.cv)) {
      I32 where_ix, is_new;
      ToRestore *to_restore;
      cix -= CxTYPE(cxstack+cix-3) == CXt_SUB && CvSPECIAL(cxstack[cix-3].blk_sub.cv) ? 3 : 2;
      where_ix=PL_scopestack[cxstack[cix].blk_oldscopesp-1];
      to_restore=newToRestore(aTHX_ where_ix, &is_new);
      if (is_new) {
	 save_ptrs(aTHX_ to_restore);
#if DebugNamespaces
	 fprintf(stderr, "restore saved in cx=%d scope=%d savesp=%d\n", cix, cxstack[cix].blk_oldscopesp-1, where_ix), fflush(stderr);
      } else {
	 fprintf(stderr, "undo already saved in cx=%d \n", cix), fflush(stderr);
#endif
      }
   }
}

#if DebugNamespaces
static
void dump_array(AV *av, const char* name)
{
   SV **impp=AvARRAY(av), **end;
   fprintf(stderr, ".%s(%d)=[", name, SvREFCNT(av));
   if (impp)
      for (end=impp+AvFILLp(av); impp<=end; ++impp)
	 fprintf(stderr, " %s", HvNAME((HV*)SvRV(*impp)));
   fprintf(stderr, " ]\n");
}
#endif

static HV *last_stash;
static AV *last_dotLOOKUP, *import_from_av;
static CV *declare_cv, *db_db, *intercept_db_db;
static int db_init=1;
static const char dot_lookup[]=".LOOKUP";
static const char dot_import[]=".IMPORT";
static const char declare[]="declare";

static
I32 append_imp_stash(AV *dotLOOKUP, HV *imp_stash)
{
   SV **lookp, **endp;
   if ((lookp=AvARRAY(dotLOOKUP)))
      for (endp=lookp+AvFILLp(dotLOOKUP); lookp<=endp; ++lookp)
	 if ((HV*)SvRV(*lookp)==imp_stash) return FALSE;
   av_push(dotLOOKUP, newRV((SV*)imp_stash));
   return TRUE;
}

static
void append_lookup(HV *stash, AV *dotLOOKUP, AV *imp_dotLOOKUP)
{
   SV **lookp=AvARRAY(imp_dotLOOKUP), **endp;
   if (lookp) {
      for (endp=lookp+AvFILLp(imp_dotLOOKUP); lookp<=endp; ++lookp) {
	 HV *imp_stash=(HV*)SvRV(*lookp);
	 if (imp_stash != stash)
	    append_imp_stash(dotLOOKUP, imp_stash);
      }
   }
}

static
AV* get_dotLOOKUP(HV *stash, I32 recursive)
{
   AV *dotLOOKUP=0;
   int i;
   GV *lookup_gv=*(GV**)hv_fetch(stash, dot_lookup, sizeof(dot_lookup)-1, TRUE);
   if (SvTYPE(lookup_gv)!=SVt_PVGV)
      gv_init(lookup_gv, stash, dot_lookup, sizeof(dot_lookup)-1, GV_ADDMULTI);
   else
      dotLOOKUP=GvAV(lookup_gv);

   if (!dotLOOKUP) {
      char *st_name=HvNAME(stash);
      I32 st_name_len=strlen(st_name);
      AV *dotIMPORT;
      GV **imp_gvp;
      dotLOOKUP=newAV();

      if ( (imp_gvp=(GV**)hv_fetch(stash, dot_import, sizeof(dot_import)-1, FALSE)) &&
	   (dotIMPORT=GvAV(*imp_gvp)) ) {
	 SV **impp=AvARRAY(dotIMPORT), **end;
	 if (impp)
	    for (end=impp+AvFILLp(dotIMPORT); impp<=end; ++impp) {
	       HV *imp_stash=(HV*)SvRV(*impp);
	       if (imp_stash != stash && append_imp_stash(dotLOOKUP, imp_stash)) {
		  AV *imp_dotLOOKUP=get_dotLOOKUP(imp_stash,TRUE);
		  if (imp_dotLOOKUP) append_lookup(stash, dotLOOKUP, imp_dotLOOKUP);
	       }
	    }

      } else {
#if DebugNamespaces
	 if (!recursive)
	    fprintf(stderr, "%s::.IMPORT unexpectedly missing\n", HvNAME(stash)), fflush(stderr);
#endif
	 return 0;
      }

      for (i=st_name_len-2; i>0; --i) {
	 if (st_name[i]==':' && st_name[i-1]==':') {
	    HV *encl_stash=gv_stashpvn(st_name, --i, FALSE);
	    if (encl_stash) {
	       if (append_imp_stash(dotLOOKUP, encl_stash)) {
		  if (hv_exists(encl_stash, dot_import, sizeof(dot_import)-1)) {
		     AV *encl_lookup=get_dotLOOKUP(encl_stash,TRUE);
		     if (encl_lookup) {
			append_lookup(stash, dotLOOKUP, encl_lookup);
			break;	/* encl_stash::.LOOKUP certainly contains all enclosing packages */
		     }
		  }
	       } else {
		  break;
	       }
	    }
	 }
      }

      GvAV(lookup_gv)=dotLOOKUP;
#if DebugNamespaces
      fprintf(stderr, "created %s::", HvNAME(stash)); dump_array(dotLOOKUP, "LOOKUP"); fflush(stderr);
#endif
      if (AvFILLp(dotLOOKUP)<0) dotLOOKUP=0;
   }

   last_stash=stash;
   last_dotLOOKUP=dotLOOKUP;
   return dotLOOKUP;
}

static
OP *pp_popmark(pTHX)
{
   (void)POPMARK;
   return NORMAL;
}

static
void lookup(pTHX_ GV *var_gv, I32 type, OP **pnext_op, OP *access_op)
{
   HV *stash=GvSTASH(var_gv);
   if (stash != PL_defstash && stash != PL_debstash) {
      const char *varname=GvNAME(var_gv);
      STRLEN varnamelen=GvNAMELEN(var_gv);
      OP *assign_op=0, *declare_op=0;
#if DebugNamespaces
      fprintf(stderr, "lookup %c%.*s in %s:", type==SVt_PV ? '$' : type==SVt_PVAV ? '@' : type==SVt_PVHV ? '%' : '&', varnamelen, varname, HvNAME(stash));
#endif
      if (access_op) {
	 switch (type) {
	 case SVt_PV:
	    declare_op= access_op->op_next->op_type == OP_SASSIGN ? (assign_op=access_op->op_next)->op_next : access_op->op_next;
	    break;
	 case SVt_PVAV:
	 case SVt_PVHV:
	    declare_op= access_op->op_next->op_type == OP_AASSIGN ? (assign_op=access_op->op_next)->op_next : access_op->op_next;
	    break;
	 }
	 if (declare_op->op_type != OP_GV || GvCV(cGVOPx_gv(declare_op)) != declare_cv)
	    declare_op=0;
      }
      if (!pnext_op || CopSTASH_eq(PL_curcop, stash)) {
	 if (declare_op) {
#if DebugNamespaces
	    fprintf(stderr, " - declared here\n"); fflush(stderr);
#endif
	    if (assign_op) /* change to void context */
	       assign_op->op_flags ^= OPf_WANT_LIST ^ OPf_WANT_VOID;
	    declare_op->op_ppaddr=&pp_popmark;
	    declare_op->op_next=declare_op->op_next->op_next;	/* skip entersub */
	    switch (type) {
	    case SVt_PV:
	       GvIMPORTED_SV_on(var_gv);
	       break;
	    case SVt_PVAV:
	       GvIMPORTED_AV_on(var_gv);
	       break;
	    case SVt_PVHV:
	       GvIMPORTED_HV_on(var_gv);
	       break;
	    }

	 } else {
	    AV *dotLOOKUP= stash==last_stash ? last_dotLOOKUP : get_dotLOOKUP(stash,FALSE);
	    if (dotLOOKUP) {
	       GV **imp_gvp;
	       SV **lookp, **endp;
	       for (lookp=AvARRAY(dotLOOKUP), endp=lookp+AvFILLp(dotLOOKUP); lookp<=endp; ++lookp) {
		  HV *imp_stash=(HV*)SvRV(*lookp);
#if DebugNamespaces
		  fprintf(stderr, " [%s]", HvNAME(imp_stash));
#endif
		  if ((imp_gvp=(GV**)hv_fetch(imp_stash, varname, varnamelen, FALSE))) {
		     GV *imp_gv=*imp_gvp;
		     CV *imp_cv;
		     switch (type) {
		     case SVt_PV:
			if (GvIMPORTED_SV(imp_gv)) {
			   SV *imp_sv=GvSV(imp_gv);
			   SvREFCNT_dec(GvSV(var_gv));
			   SvREFCNT_inc(imp_sv);
			   GvSV(var_gv)=imp_sv;
			   GvIMPORTED_SV_on(var_gv);
#if DebugNamespaces
			   fprintf(stderr, " - found\n"); fflush(stderr);
#endif
			   return;
			}
			break;
		     case SVt_PVAV:
			if (GvIMPORTED_AV(imp_gv)) {
			   AV *imp_av=GvAV(imp_gv);
			   SvREFCNT_dec(GvAV(var_gv));
			   SvREFCNT_inc(imp_av);
			   GvAV(var_gv)=imp_av;
			   GvIMPORTED_AV_on(var_gv);
#if DebugNamespaces
			   fprintf(stderr, " - found\n"); fflush(stderr);
#endif
			   return;
			}
			break;
		     case SVt_PVHV:
			if (GvIMPORTED_HV(imp_gv)) {
			   HV *imp_hv=GvHV(imp_gv);
			   SvREFCNT_dec(GvHV(var_gv));
			   SvREFCNT_inc(imp_hv);
			   GvHV(var_gv)=imp_hv;
			   GvIMPORTED_HV_on(var_gv);
#if DebugNamespaces
			   fprintf(stderr, " - found\n"); fflush(stderr);
#endif
			   return;
			}
			break;
		     case SVt_PVCV:
			if ((imp_cv=GvCV(imp_gv)) && !CvMETHOD(imp_cv)) {
			   SvREFCNT_inc(imp_cv);
			   GvCV(var_gv)=imp_cv;
			   GvIMPORTED_CV_on(var_gv);
#if DebugNamespaces
			   fprintf(stderr, " - found(%s)\n", CvROOT(imp_cv) || CvXSUB(imp_cv) ? "defined" : "undef"); fflush(stderr);
#endif
			   return;
			}
		     }
		  }
	       }
	    }

	    if (pnext_op) {
	       /* check for exceptions */
	       switch (type) {
	       case SVt_PVCV:
		  /* pp_entersub will produce a suitable message when it gets stuck on the undefined sub */
		  return;

	       case SVt_PV:
		  if (varnamelen==8 && *varname=='A' && !memcmp(varname, "AUTOLOAD", 8)
		      && GvCV(var_gv)) {
		     /* allow to use $AUTOLOAD if there is a sub AUTOLOAD */
		     GvIMPORTED_SV_on(var_gv);
		     return;
		  }
		  if (PL_curstackinfo->si_type == PERLSI_SORT  &&
		      varnamelen==1 && (*varname=='a' || *varname=='b'))
		     /* allow to use sort placeholders: sort { $a <=> $b } */
		     return;

		  break;
	       case SVt_PVAV:
		  if (varnamelen==3 && varname[0]=='I' && varname[1]=='S' && varname[2]=='A') {
		     /* allow to use @ISA */
		     GvIMPORTED_AV_on(var_gv);
		     return;
		  }
	       }
	       *pnext_op=die("reference to an undeclared variable %c%.*s",
			     type==SVt_PV ? '$' : type==SVt_PVAV ? '@' : '%',
			     varnamelen, varname);
	    }
#if DebugNamespaces
	    else
	       fprintf(stderr, " - nowhere\n"), fflush(stderr);
#endif
	 }

      } else if (type != SVt_PVCV && hv_exists(stash, dot_import, sizeof(dot_import)-1)) {
	 /* full qualified, but undeclared */
	 /* check for exceptions */
	 switch (type) {
	 case SVt_PVHV:
	    if (varnamelen>=3 && varname[varnamelen-2]==':' && varname[varnamelen-1]==':'
		&& GvHV(var_gv) && HvNAME(GvHV(var_gv)))
	       /* allow to refer to the symbol table of a defined package */
	       return;

	    break;
	 }

	 *pnext_op= declare_op
	            ? die("can't declare variables from other packages")
	            : die("reference to an undeclared variable %c%s::%.*s",
			  type==SVt_PV ? '$' : type==SVt_PVAV ? '@' : '%',
			  HvNAME(stash), varnamelen, varname);
      }
   }
}

static
OP* intercept_pp_gv(pTHX)
{
   OP *next_op=pp_gv();
   dSP;
   GV *var_gv=(GV*)TOPs;
   CV *cv;
#ifdef not_PERL_5_8
   while (next_op->op_type == OP_NULL)
      next_op=next_op->op_next;
#endif
   switch (next_op->op_type) {
   case OP_RV2SV:
      if (!GvIMPORTED_SV(var_gv))
	 lookup(aTHX_ var_gv, SVt_PV, &next_op, next_op);
      break;
   case OP_RV2AV:
      if (!GvIMPORTED_AV(var_gv))
	 lookup(aTHX_ var_gv, SVt_PVAV, &next_op, next_op);
      break;
   case OP_RV2HV:
      if (!GvIMPORTED_HV(var_gv))
	 lookup(aTHX_ var_gv, SVt_PVHV, &next_op, next_op);
      break;
   case OP_RV2CV:
      if ((cv=GvCV(var_gv)) && (next_op->op_next->op_type != OP_REFGEN || CvROOT(cv) || CvXSUB(cv)))
	 break;
      lookup(aTHX_ var_gv, SVt_PVCV, &next_op, 0);
      break;
   case OP_ENTERSUB:
      if (!GvCV(var_gv))
	 lookup(aTHX_ var_gv, SVt_PVCV, &next_op, 0);
      break;
   }
   if (next_op == PL_op->op_next)	/* not died */
      PL_op->op_ppaddr=&Perl_pp_gv;
   return next_op;
}

static
OP* intercept_pp_rv2gv(pTHX)
{
   OP *next_op=pp_rv2gv(), *declare_op=0;
   I32 defuse=FALSE;
   if (next_op->op_type==OP_SASSIGN) {
      declare_op=next_op->op_next;
      if (declare_op->op_type == OP_GV && GvCV(cGVOPx_gv(declare_op)) == declare_cv) {
	 dSP;
	 GV *dst_gv=(GV*)TOPs;
	 SV *src_sv=TOPm1s;
	 if (SvROK(src_sv)) {
	    I32 src_type=SvTYPE(SvRV(src_sv));
	    switch (src_type) {
	    case SVt_PVAV:
	       GvIMPORTED_AV_on(dst_gv);
	       defuse=TRUE;
	       break;
	    case SVt_PVHV:
	       GvIMPORTED_HV_on(dst_gv);
	       defuse=TRUE;
	       break;
	    default:
	       if (src_type >= SVt_IV && src_type <= SVt_PVMG) {
		  GvIMPORTED_SV_on(dst_gv);
		  defuse=TRUE;
	       }
	       break;
	    }
	 } else if (SvTYPE(src_sv)==SVt_PVGV) {
	    defuse=TRUE;
	 }
      }
   }
   if (defuse) {
      if (declare_op->op_ppaddr != &pp_popmark) {
	 /* change to void context */
	 next_op->op_flags ^= OPf_WANT_LIST ^ OPf_WANT_VOID;
	 /* skip entersub */
	 declare_op->op_ppaddr=&pp_popmark;
	 declare_op->op_next=declare_op->op_next->op_next;
      }
   } else {
      PL_op->op_ppaddr=&Perl_pp_rv2gv;
   }
   return next_op;
}

static
OP* intercept_pp_gvsv(pTHX)
{
   GV *var_gv=cGVOP_gv;
   OP *next_op=0;
   if (!GvIMPORTED_SV(var_gv))
      lookup(aTHX_ var_gv, SVt_PV, &next_op, PL_op);
   if (next_op) return next_op;	/* died */
   PL_op->op_ppaddr=&Perl_pp_gvsv;
   return pp_gvsv();
}

static
OP* intercept_pp_aelemfast(pTHX)
{
   if (!(PL_op->op_flags & OPf_SPECIAL)) {
      GV *var_gv=cGVOP_gv;
      OP *next_op=0;
      if (!GvIMPORTED_AV(var_gv))
	 lookup(aTHX_ var_gv, SVt_PVAV, &next_op, 0);
      if (next_op) return next_op;	/* died */
   }
   PL_op->op_ppaddr=&Perl_pp_aelemfast;
   return pp_aelemfast();
}

static
AV* get_dotIMPORT(HV *stash, I32 unique)
{
   GV *imp_gv=*(GV**)hv_fetch(stash, dot_import, sizeof(dot_import)-1, TRUE);
   AV *dotIMPORT=0;
   if (SvTYPE(imp_gv)!=SVt_PVGV)
      gv_init(imp_gv, stash, dot_import, sizeof(dot_import)-1, GV_ADDMULTI);
   else
      dotIMPORT=GvAV(imp_gv);

   if (!dotIMPORT) {
      GV *declare_gv=*(GV**)hv_fetch(stash, declare, sizeof(declare)-1, TRUE);
      if (SvTYPE(declare_gv)!=SVt_PVGV)
	 gv_init(declare_gv, stash, declare, sizeof(declare)-1, GV_ADDMULTI);
      sv_setsv((SV*)declare_gv, sv_2mortal(newRV((SV*)declare_cv)));
      if (AvFILLp(import_from_av)>=0) {
	 GvAV(imp_gv)=dotIMPORT=(AV*)SvRV(AvARRAY(import_from_av)[AvFILLp(import_from_av)]);
	 SvREFCNT_inc(dotIMPORT);
      } else {
	 GvAV(imp_gv)=dotIMPORT=newAV();
      }
#if DebugNamespaces
      fprintf(stderr, "created %s::", HvNAME(stash)); dump_array(dotIMPORT, "IMPORT"); fflush(stderr);
#endif
   }
   if (unique && SvREFCNT(dotIMPORT)>1) {
      SvREFCNT_dec(dotIMPORT);
      return (GvAV(imp_gv)=av_make(AvFILLp(dotIMPORT)+1, AvARRAY(dotIMPORT)));
   }
   return dotIMPORT;
}

static
OP* ck_const(pTHX_ OP *o)
{
   if (PL_curcop == &PL_compiling) {
      SV *sv=cSVOPo->op_sv;
      const char *buf=PL_bufptr;
      if (buf && SvPOKp(sv) && buf[0] == 'p' && !strncmp(buf, "package ", 8)) {
	 HV *stash=gv_stashpvn(SvPVX(sv), SvCUR(sv), TRUE);
	 if (stash != PL_defstash && stash != PL_debstash)
	    get_dotIMPORT(stash, FALSE);
      }
   }
   return ck_svconst(o);
}

static
OP* intercept_pp_require(pTHX)
{
   OP *ret;
   dSP;
   I32 enter_cix, from_BEGIN;
   STRLEN pnl;
   const char *pn;
   if (SvNIOKp(TOPs)) return pp_require();	/* version check */
   pn=SvPV(TOPs,pnl);
   if (pnl==13 && !memcmp(pn, "namespaces.pm", 13)) RETPUSHYES;

   enter_cix=cxstack_ix;
   from_BEGIN=CxTYPE(cxstack+enter_cix)==CXt_SUB && CvSPECIAL(cxstack[enter_cix].blk_sub.cv);
#if DebugNamespaces
   fprintf(stderr, "require %.*s\ncx[%d]: type=%d%s scope=%d savesp=%d\n", pnl, pn, cxstack_ix, cxstack[cxstack_ix].cx_type, from_BEGIN ? "(BEGIN)" : "", cxstack[cxstack_ix].blk_oldscopesp, PL_scopestack[cxstack[cxstack_ix].blk_oldscopesp]);
#endif
   if (from_BEGIN) {
      I32 where_ix=PL_scopestack[cxstack[enter_cix].blk_oldscopesp-1], is_new;
      ToRestore *to_restore=newToRestore(aTHX_ where_ix, &is_new);
      if (is_new) {
	 to_restore->import_from_level=AvFILLp(import_from_av);
	 to_restore->recover=catch_ptrs;
#if DebugNamespaces
	 fprintf(stderr, "catch saved in cx=%d scope=%d savesp=%d\n", enter_cix, cxstack[enter_cix].blk_oldscopesp-1, where_ix);
#endif
      } else {
	 DIE(aTHX_ "restore already installed in cx=%d scope=%d savesp=%d", enter_cix, cxstack[enter_cix].blk_oldscopesp-1, where_ix);
      }
   }
#if DebugNamespaces
   fflush(stderr);
#endif

   reset_ptrs(aTHX);
   ret=pp_require();
#if DebugNamespaces
   fprintf(stderr, "RETURN require: cx=%d\n", cxstack_ix); fflush(stderr);
#endif
   if (!from_BEGIN) {
      if (cxstack_ix>enter_cix) {
	 I32 where_ix=PL_scopestack[cxstack[cxstack_ix].blk_oldscopesp-1], is_new;
	 ToRestore *to_restore=newToRestore(aTHX_ where_ix, &is_new);
	 if (is_new)
	    to_restore->import_from_level=AvFILLp(import_from_av);
	 to_restore->recover=catch_ptrs;
#if DebugNamespaces
	 fprintf(stderr, "catch %s in cx=%d scope=%d savesp=%d\n", is_new ? "saved" : "replaced restore", cxstack_ix, cxstack[cxstack_ix].blk_oldscopesp-1, where_ix), fflush(stderr);
#endif
      } else {
	 catch_ptrs(aTHX_ 0);
      }
   }
   return ret;
}

static
OP* intercept_pp_entereval(pTHX)
{
   OP *next_op;
   I32 strict_vars=0, level=AvFILLp(import_from_av), enter_cix=cxstack_ix;
   AV *my_imports=get_dotIMPORT(CopSTASH(PL_curcop), FALSE);
   I32 need_change= PL_check[OP_CONST]!=&ck_const;
   if (need_change) {
#if DebugNamespaces
      fprintf(stderr, "eval: enabling namespaces inherited from %s level=%d ", HvNAME(CopSTASH(PL_curcop)), level);
      dump_array(my_imports,"IMPORT"); fflush(stderr);
#endif
      strict_vars=PL_hints & HINT_STRICT_VARS;
      catch_ptrs(aTHX_ 0);
      av_push(import_from_av, newRV((SV*)my_imports));
   }
   next_op=pp_entereval();

   if (need_change) {
#if DebugNamespaces
      fprintf(stderr, "eval: disabling namespaces -> level=%d\n", level);
#endif
      reset_ptrs(aTHX);
      if (!strict_vars) PL_hints &= ~HINT_STRICT_VARS;
      av_fill(import_from_av, level);
      if (cxstack_ix>enter_cix)
	 removeToRestore(aTHX_ PL_scopestack[cxstack[cxstack_ix].blk_oldscopesp-1]);
   }
   return next_op;
}

static
void restore_ptrs_noDB(pTHX_ ToRestore *to_restore)
{
   PL_ppaddr[OP_GV]=to_restore->gv;
   PL_ppaddr[OP_GVSV]=to_restore->gvsv;
   PL_ppaddr[OP_RV2GV]=to_restore->rv2gv;
   PL_ppaddr[OP_AELEMFAST]=to_restore->aelemfast;
   PL_ppaddr[OP_REQUIRE]=to_restore->require;
   PL_ppaddr[OP_ENTEREVAL]=to_restore->entereval;
   PL_check[OP_CONST]=to_restore->ck_const;
   PL_hints |= to_restore->hints;
   av_fill(import_from_av, to_restore->import_from_level);
}

static
void restore_ptrs_DB(pTHX_ ToRestore *to_restore)
{
   restore_ptrs_noDB(aTHX_ to_restore);
   GvCV(PL_DBgv)=to_restore->db_db;
}

static
void save_ptrs_noDB(pTHX_ ToRestore *to_restore)
{
   to_restore->gv=PL_ppaddr[OP_GV];
   to_restore->gvsv=PL_ppaddr[OP_GVSV];
   to_restore->rv2gv=PL_ppaddr[OP_RV2GV];
   to_restore->aelemfast=PL_ppaddr[OP_AELEMFAST];
   to_restore->require=PL_ppaddr[OP_REQUIRE];
   to_restore->entereval=PL_ppaddr[OP_ENTEREVAL];
   to_restore->ck_const=PL_check[OP_CONST];
   to_restore->hints=PL_hints & HINT_STRICT_VARS;
   to_restore->import_from_level=AvFILLp(import_from_av);
   to_restore->recover=&restore_ptrs_noDB;
}

static
void save_ptrs_DB(pTHX_ ToRestore *to_restore)
{
   save_ptrs_noDB(aTHX_ to_restore);
   to_restore->db_db=GvCV(PL_DBgv);
   to_restore->recover=&restore_ptrs_DB;
}

static
void catch_ptrs_noDB(pTHX_ ToRestore *to_restore)
{
   PL_ppaddr[OP_GV]=&intercept_pp_gv;
   PL_ppaddr[OP_GVSV]=&intercept_pp_gvsv;
   PL_ppaddr[OP_RV2GV]=&intercept_pp_rv2gv;
   PL_ppaddr[OP_AELEMFAST]=&intercept_pp_aelemfast;
   PL_ppaddr[OP_REQUIRE]=&intercept_pp_require;
   PL_ppaddr[OP_ENTEREVAL]=&intercept_pp_entereval;
   PL_check[OP_CONST]=&ck_const;
   PL_hints &= ~HINT_STRICT_VARS;
   if (to_restore) av_fill(import_from_av, to_restore->import_from_level);
}

static
void catch_ptrs_DB(pTHX_ ToRestore *to_restore)
{
   catch_ptrs_noDB(aTHX_ to_restore);
   GvCV(PL_DBgv)=intercept_db_db;
}

static
void reset_ptrs_noDB(pTHX)
{
   PL_ppaddr[OP_GV]=&Perl_pp_gv;
   PL_ppaddr[OP_GVSV]=&Perl_pp_gvsv;
   PL_ppaddr[OP_RV2GV]=&Perl_pp_rv2gv;
   PL_ppaddr[OP_AELEMFAST]=&Perl_pp_aelemfast;
   PL_ppaddr[OP_REQUIRE]=&Perl_pp_require;
   PL_ppaddr[OP_ENTEREVAL]=&Perl_pp_entereval;
   PL_check[OP_CONST]=&Perl_ck_svconst;
   PL_hints |= HINT_STRICT_VARS;
}

static
void reset_ptrs_DB(pTHX)
{
   reset_ptrs_noDB(aTHX);
   GvCV(PL_DBgv)=db_db;
}

MODULE = namespaces		PACKAGE = namespaces

PROTOTYPES: DISABLE

void
import(...)
CODE:
{
   I32 i;
   AV *new_imports=newAV();
   register_undo(aTHX);
   catch_ptrs(aTHX_ 0);
   for (i=1; i<items; ++i) {
      STRLEN l;
      const char *n=SvPV(ST(i),l);
      HV *imp_stash=gv_stashpvn(n, l, FALSE);
      if (imp_stash)
	 av_push(new_imports, newRV((SV*)imp_stash));
   }
   av_push(import_from_av, newRV_noinc((SV*)new_imports));
   if (!db_init) {
      OP *o;
      CV *disable_cv;
      for (o=CvSTART(intercept_db_db); o && o->op_type!=OP_LEAVESUB; o=o->op_next)
	 if (o->op_type==OP_DBSTATE)
	    o->op_ppaddr=&Perl_pp_nextstate;
      CvFLAGS(intercept_db_db) |= CVf_NODEBUG;
      disable_cv=get_cv("namespaces::disable", FALSE);
      CvFLAGS(disable_cv) |= CVf_NODEBUG;
      db_init=1;
   }
}

void
unimport(...)
CODE:
{
   if (items>0)
      register_undo(aTHX);
   if (items>1) {
      if (AvFILLp(import_from_av)>=0) {
	 AV *cur_imports=(AV*)SvRV(AvARRAY(import_from_av)[AvFILLp(import_from_av)]);
	 SV **impp=AvARRAY(cur_imports), **end;
	 if (impp) {
	    AV *new_imports=newAV();
	    I32 i, last_found=0;
	    for (i=1; i<items; ++i) {
	       STRLEN l;
	       const char *n=SvPV(ST(i),l);
	       HV *imp_stash=gv_stashpvn(n, l, FALSE);
	       if (imp_stash) {
		  ST(last_found)=(SV*)imp_stash; ++last_found;
	       }
	    }
	    for (end=impp+AvFILLp(cur_imports); impp<=end; ++impp) {
	       HV *imp=(HV*)SvRV(*impp);
	       for (i=0; i<last_found && imp!=(HV*)ST(i); ++i) ;
	       if (i==last_found)
		  av_push(new_imports, newRV((SV*)imp));
	    }
	    av_push(import_from_av, newRV_noinc((SV*)new_imports));
	 }
      }
   } else {
#if DebugNamespaces
      fprintf(stderr, "namespaces::reset\n"), fflush(stderr);
#endif
      reset_ptrs(aTHX);
   }
   XSRETURN_EMPTY;
}

void
disable()
CODE:
{
   I32 cix=cxstack_ix-1;
   I32 where_ix, is_new;
   ToRestore *to_restore;
   where_ix=PL_scopestack[cxstack[cix].blk_oldscopesp-1];
   to_restore=newToRestore(aTHX_ where_ix, &is_new);
   if (is_new) {
      save_ptrs(aTHX_ to_restore);
#if DebugNamespaces
      fprintf(stderr, "disable: restore saved in cx=%d type=%d scope=%d savesp=%d\n", cix, cxstack[cix].cx_type, cxstack[cix].blk_oldscopesp-1, where_ix), fflush(stderr);
   } else {
      fprintf(stderr, "disable: undo already saved in cx=%d \n", cix), fflush(stderr);
#endif
   }
   reset_ptrs(aTHX);
   XSRETURN_EMPTY;
}

void
using(dst, ...)
   SV *dst;
CODE:
{
   HV *caller_stash=
      (SvCUR(dst)==10 && !memcmp(SvPVX(dst),"namespaces",10))
      ? CopSTASH(PL_curcop)
      : gv_stashpvn(SvPVX(dst), SvCUR(dst), TRUE);
   I32 i;
   AV *dotLOOKUP, *dotIMPORT;
   GV **av_gvp=(GV**)hv_fetch(caller_stash, dot_lookup, sizeof(dot_lookup)-1, FALSE);

   if (av_gvp && SvTYPE(*av_gvp) == SVt_PVGV && (dotLOOKUP=GvAV(*av_gvp))) {
      for (i=1; i<items; ++i) {
	 STRLEN l;
	 const char *n=SvPV(ST(i),l);
	 HV *imp_stash=gv_stashpvn(n, l, FALSE);
	 if (imp_stash != caller_stash && append_imp_stash(dotLOOKUP, imp_stash)) {
	    AV *imp_dotLOOKUP=get_dotLOOKUP(imp_stash,TRUE);
	    if (imp_dotLOOKUP) append_lookup(caller_stash, dotLOOKUP, imp_dotLOOKUP);
	 }
      }
#if DebugNamespaces
      fprintf(stderr, "added to %s::", HvNAME(caller_stash)); dump_array(dotLOOKUP, "LOOKUP"); fflush(stderr);
#endif
      
   } else {
      dotIMPORT=get_dotIMPORT(caller_stash, TRUE);
      for (i=1; i<items; ++i) {
	 STRLEN l;
	 const char *n=SvPV(ST(i),l);
	 HV *imp_stash=gv_stashpvn(n, l, FALSE);
	 if (imp_stash && imp_stash != caller_stash)
	    av_push(dotIMPORT, newRV((SV*)imp_stash));
      }
#if DebugNamespaces
      fprintf(stderr, "added to %s::", HvNAME(caller_stash)); dump_array(dotIMPORT, "IMPORT"); fflush(stderr);
#endif
   }
}

void lookup_sub(pkg, subname)
   SV *pkg;
   SV *subname;
PPCODE:
{
   STRLEN l;
   const char *n=SvPV(pkg,l);
   HV *stash=gv_stashpvn(n, l, FALSE);
   if (stash) {
      GV *gv;
      CV *cv;
      n=SvPV(subname,l);
      gv=*(GV**)hv_fetch(stash, n, l, TRUE);
      if (SvTYPE(gv) != SVt_PVGV)
	 gv_init(gv, stash, n, l, GV_ADDMULTI);
      lookup(aTHX_ gv, SVt_PVCV, 0, 0);
      cv=GvCV(gv);
      if (cv && (CvROOT(cv) || CvXSUB(cv))) {
	 PUSHs(sv_2mortal(newRV((SV*)cv)));
	 XSRETURN(1);
      }
   }
   XSRETURN_UNDEF;
}

void
declare(...)
CODE:
{
   croak("multiple declaration of a variable");
}
items=0;

BOOT:
{
   last_stash=0;
   import_from_av=get_av("namespaces::IMPORT_FROM", TRUE);
   declare_cv=get_cv("namespaces::declare", TRUE);
   if (PL_DBgv) {
      db_init=0;
      db_db=GvCV(PL_DBgv);
      intercept_db_db=get_cv("namespaces::interceptDB", TRUE);
      save_ptrs=&save_ptrs_DB;
      catch_ptrs=&catch_ptrs_DB;
      reset_ptrs=&reset_ptrs_DB;
   } else {
      intercept_db_db=0;
      save_ptrs=&save_ptrs_noDB;
      catch_ptrs=&catch_ptrs_noDB;
      reset_ptrs=&reset_ptrs_noDB;
   }
}
