Declare.xs

   1 #define PERL_CORE
   2 #define PERL_NO_GET_CONTEXT
   3 #include "EXTERN.h"
   4 #include "perl.h"
   5 #include "XSUB.h"
   6 #undef printf
   7 #include "stolen_chunk_of_toke.c"
   8 #include <stdio.h>
   9 #include <string.h>
  10
  11 #define DD_HAS_TRAITS
  12 #if 0
  13 #define DD_DEBUG
  14 #endif
  15
  16 #define DD_HANDLE_NAME 1
  17 #define DD_HANDLE_PROTO 2
  18 #define DD_HANDLE_PACKAGE 8
  19
  20 #ifdef DD_DEBUG
  21 #define DD_DEBUG_S printf("Buffer: %s\n", s);
  22 #else
  23 #define DD_DEBUG_S
  24 #endif
  25
  26 #define LEX_NORMAL    10
  27 #define LEX_INTERPNORMAL   9
  28
  29 /* placeholders for PL_check entries we wrap */
  30
  31 STATIC OP *(*dd_old_ck_rv2cv)(pTHX_ OP *op);
  32 STATIC OP *(*dd_old_ck_lineseq)(pTHX_ OP *op);
  33
  34 /* flag to trigger removal of temporary declaree sub */
  35
  36 static int in_declare = 0;
  37
  38 /* replacement PL_check rv2cv entry */
  39
  40 STATIC OP *dd_ck_rv2cv(pTHX_ OP *o) {
  41   OP* kid;
  42   char* s;
  43   char* save_s;
  44   char tmpbuf[sizeof PL_tokenbuf];
  45   char found_name[sizeof PL_tokenbuf];
  46   char* found_proto = NULL, *found_traits = NULL;
  47   STRLEN len = 0;
  48   HV *stash;
  49   HV* is_declarator;
  50   SV** is_declarator_pack_ref;
  51   HV* is_declarator_pack_hash;
  52   SV** is_declarator_flag_ref;
  53   int dd_flags;
  54   char* cb_args[6];
  55   dSP; /* define stack pointer for later call stuff */
  56   char* retstr;
  57   STRLEN n_a; /* for POPpx */
  58
  59   o = dd_old_ck_rv2cv(aTHX_ o); /* let the original do its job */
  60
  61   if (in_declare) {
  62     cb_args[0] = NULL;
  63     call_argv("Devel::Declare::done_declare", G_VOID|G_DISCARD, cb_args);
  64     in_declare--;
  65     return o;
  66   }
  67
  68   kid = cUNOPo->op_first;
  69
  70   if (kid->op_type != OP_GV) /* not a GV so ignore */
  71     return o;
  72
  73   if (PL_lex_state != LEX_NORMAL && PL_lex_state != LEX_INTERPNORMAL)
  74     return o; /* not lexing? */
  75
  76   stash = GvSTASH(kGVOP_gv);
  77
  78 #ifdef DD_DEBUG
  79   printf("Checking GV %s -> %s\n", HvNAME(stash), GvNAME(kGVOP_gv));
  80 #endif
  81
  82   is_declarator = get_hv("Devel::Declare::declarators", FALSE);
  83
  84   if (!is_declarator)
  85     return o;
  86
  87   is_declarator_pack_ref = hv_fetch(is_declarator, HvNAME(stash),
  88                              strlen(HvNAME(stash)), FALSE);
  89
  90   if (!is_declarator_pack_ref || !SvROK(*is_declarator_pack_ref))
  91     return o; /* not a hashref */
  92
  93   is_declarator_pack_hash = (HV*) SvRV(*is_declarator_pack_ref);
  94
  95   is_declarator_flag_ref = hv_fetch(is_declarator_pack_hash, GvNAME(kGVOP_gv),
  96                                 strlen(GvNAME(kGVOP_gv)), FALSE);
  97
  98   /* requires SvIOK as well as TRUE since flags not being an int is useless */
  99
 100   if (!is_declarator_flag_ref
 101         || !SvIOK(*is_declarator_flag_ref)
 102         || !SvTRUE(*is_declarator_flag_ref))
 103     return o;
 104
 105   dd_flags = SvIVX(*is_declarator_flag_ref);
 106
 107 #ifdef DD_DEBUG
 108   printf("dd_flags are: %i\n", dd_flags);
 109 #endif
 110
 111   s = PL_bufptr; /* copy the current buffer pointer */
 112
 113   DD_DEBUG_S
 114
 115 #ifdef DD_DEBUG
 116   printf("PL_tokenbuf: %s\n", PL_tokenbuf);
 117 #endif
 118
 119   /*
 120    *   buffer will be at the beginning of the declarator, -unless- the
 121    *   declarator is at EOL in which case it'll be the next useful line
 122    *   so we don't short-circuit out if we don't find the declarator
 123    */
 124
 125   while (s < PL_bufend && isSPACE(*s)) s++;
 126   if (memEQ(s, PL_tokenbuf, strlen(PL_tokenbuf)))
 127     s += strlen(PL_tokenbuf);
 128
 129   DD_DEBUG_S
 130
 131   if (dd_flags & DD_HANDLE_NAME) {
 132
 133     /* find next word */
 134
 135     s = skipspace(s);
 136
 137     DD_DEBUG_S
 138
 139     /* arg 4 is allow_package */
 140
 141     s = scan_word(s, tmpbuf, sizeof tmpbuf, dd_flags & DD_HANDLE_PACKAGE, &len);
 142
 143     DD_DEBUG_S
 144
 145     if (len) {
 146       strcpy(found_name, tmpbuf);
 147 #ifdef DD_DEBUG
 148       printf("Found %s\n", found_name);
 149 #endif
 150     }
 151   }
 152
 153   if (dd_flags & DD_HANDLE_PROTO) {
 154
 155     s = skipspace(s);
 156
 157     if (*s == '(') { /* found a prototype-ish thing */
 158       save_s = s;
 159       s = scan_str(s, FALSE, FALSE); /* no keep_quoted, no keep_delims */
 160 #ifdef DD_HAS_TRAITS
 161       {
 162           char *traitstart = s = skipspace(s);
 163
 164           while (*s && *s != '{') ++s;
 165           if (*s) {
 166               int tlen = s - traitstart;
 167               Newx(found_traits, tlen+1, char);
 168               Copy(traitstart, found_traits, tlen, char);
 169               found_traits[tlen] = 0;
 170 #ifdef DD_DEBUG
 171               printf("found traits..... (%s)\n", found_traits);
 172 #endif
 173           }
 174       }
 175 #endif
 176
 177       if (SvPOK(PL_lex_stuff)) {
 178 #ifdef DD_DEBUG
 179         printf("Found proto %s\n", SvPVX(PL_lex_stuff));
 180 #endif
 181         found_proto = SvPVX(PL_lex_stuff);
 182         if (len) /* foo name () => foo name  X, only foo parsed so works */
 183           *save_s++ = ' ';
 184         else /* foo () => foo =X, TOKEN('&') won't handle foo X */
 185           *save_s++ = '=';
 186         *save_s++ = 'X';
 187         while (save_s < s) {
 188           *save_s++ = ' ';
 189         }
 190 #ifdef DD_DEBUG
 191         printf("Curbuf %s\n", PL_bufptr);
 192 #endif
 193       }
 194     }
 195   }
 196
 197   if (!len)
 198     found_name[0] = 0;
 199
 200 #ifdef DD_DEBUG
 201   printf("Calling init_declare\n");
 202 #endif
 203   cb_args[0] = HvNAME(stash);
 204   cb_args[1] = GvNAME(kGVOP_gv);
 205   cb_args[2] = HvNAME(PL_curstash);
 206   cb_args[3] = found_name;
 207   cb_args[4] = found_proto;
 208   cb_args[5] = found_traits;
 209   cb_args[6] = NULL;
 210
 211   if (len && found_proto)
 212     in_declare = 2;
 213   else if (len || found_proto)
 214     in_declare = 1;
 215   if (found_proto)
 216     PL_lex_stuff = Nullsv;
 217   s = skipspace(s);
 218 #ifdef DD_DEBUG
 219   printf("cur buf: %s\n", s);
 220   printf("bufend at: %i\n", PL_bufend - s);
 221   printf("linestr: %s\n", SvPVX(PL_linestr));
 222   printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
 223 #endif
 224   if (*s++ == '{') {
 225     call_argv("Devel::Declare::init_declare", G_SCALAR, cb_args);
 226     SPAGAIN;
 227     retstr = POPpx;
 228     PUTBACK;
 229     if (retstr && strlen(retstr)) {
 230       const int old_len = SvCUR(PL_linestr);
 231 #ifdef DD_DEBUG
 232       printf("Got string %s\n", retstr);
 233       printf("retstr len: %d, old_len %d\n", strlen(retstr), old_len);
 234 #endif
 235       SvGROW(PL_linestr, (STRLEN)(old_len + strlen(retstr)));
 236       memmove(s+strlen(retstr), s, (PL_bufend - s)+1);
 237       memmove(s, retstr, strlen(retstr));
 238       SvCUR_set(PL_linestr, old_len + strlen(retstr));
 239       PL_bufend += strlen(retstr);
 240 #ifdef DD_DEBUG
 241   printf("cur buf: %s\n", s);
 242   printf("bufend at: %i\n", PL_bufend - s);
 243   printf("linestr: %s\n", SvPVX(PL_linestr));
 244   printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
 245 #endif
 246     }
 247   } else {
 248     call_argv("Devel::Declare::init_declare", G_VOID|G_DISCARD, cb_args);
 249   }
 250   return o;
 251 }
 252
 253 STATIC OP *dd_ck_lineseq(pTHX_ OP *o) {
 254   AV* pad_inject_list;
 255   SV** to_inject_ref;
 256   int i, pad_inject_list_last;
 257
 258   o = dd_old_ck_lineseq(aTHX_ o);
 259
 260   pad_inject_list = get_av("Devel::Declare::next_pad_inject", FALSE);
 261   if (!pad_inject_list)
 262     return o;
 263
 264   pad_inject_list_last = av_len(pad_inject_list);
 265
 266   if (pad_inject_list_last == -1)
 267     return o;
 268
 269   for (i = 0; i <= pad_inject_list_last; i++) {
 270     to_inject_ref = av_fetch(pad_inject_list, i, FALSE);
 271     if (to_inject_ref && SvPOK(*to_inject_ref)) {
 272 #ifdef DD_DEBUG
 273   printf("Injecting %s into pad\n", SvPVX(*to_inject_ref));
 274 #endif
 275       allocmy(SvPVX(*to_inject_ref));
 276     }
 277   }
 278
 279   av_clear(pad_inject_list);
 280
 281   return o;
 282 }
 283
 284 static int initialized = 0;
 285
 286 MODULE = Devel::Declare  PACKAGE = Devel::Declare
 287
 288 PROTOTYPES: DISABLE
 289
 290 void
 291 setup()
 292   CODE:
 293   if (!initialized++) {
 294     dd_old_ck_rv2cv = PL_check[OP_RV2CV];
 295     PL_check[OP_RV2CV] = dd_ck_rv2cv;
 296     dd_old_ck_lineseq = PL_check[OP_LINESEQ];
 297     PL_check[OP_LINESEQ] = dd_ck_lineseq;
 298   }
 299
 300 void
 301 teardown()
 302   CODE:
 303   /* ensure we only uninit when number of teardown calls matches
 304      number of setup calls */
 305   if (initialized && !--initialized) {
 306     PL_check[OP_RV2CV] = dd_old_ck_rv2cv;
 307   }