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 #ifdef DD_DEBUG
  64     printf("Deconstructing declare\n");
  65     printf("PL_bufptr: %s\n", PL_bufptr);
  66     printf("bufend at: %i\n", PL_bufend - PL_bufptr);
  67     printf("linestr: %s\n", SvPVX(PL_linestr));
  68     printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
  69 #endif
  70     call_argv("Devel::Declare::done_declare", G_VOID|G_DISCARD, cb_args);
  71     in_declare--;
  72 #ifdef DD_DEBUG
  73     printf("PL_bufptr: %s\n", PL_bufptr);
  74     printf("bufend at: %i\n", PL_bufend - PL_bufptr);
  75     printf("linestr: %s\n", SvPVX(PL_linestr));
  76     printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
  77     printf("actual len: %i\n", strlen(PL_bufptr));
  78 #endif
  79     return o;
  80   }
  81
  82   kid = cUNOPo->op_first;
  83
  84   if (kid->op_type != OP_GV) /* not a GV so ignore */
  85     return o;
  86
  87   if (PL_lex_state != LEX_NORMAL && PL_lex_state != LEX_INTERPNORMAL)
  88     return o; /* not lexing? */
  89
  90   stash = GvSTASH(kGVOP_gv);
  91
  92 #ifdef DD_DEBUG
  93   printf("Checking GV %s -> %s\n", HvNAME(stash), GvNAME(kGVOP_gv));
  94 #endif
  95
  96   is_declarator = get_hv("Devel::Declare::declarators", FALSE);
  97
  98   if (!is_declarator)
  99     return o;
 100
 101   is_declarator_pack_ref = hv_fetch(is_declarator, HvNAME(stash),
 102                              strlen(HvNAME(stash)), FALSE);
 103
 104   if (!is_declarator_pack_ref || !SvROK(*is_declarator_pack_ref))
 105     return o; /* not a hashref */
 106
 107   is_declarator_pack_hash = (HV*) SvRV(*is_declarator_pack_ref);
 108
 109   is_declarator_flag_ref = hv_fetch(is_declarator_pack_hash, GvNAME(kGVOP_gv),
 110                                 strlen(GvNAME(kGVOP_gv)), FALSE);
 111
 112   /* requires SvIOK as well as TRUE since flags not being an int is useless */
 113
 114   if (!is_declarator_flag_ref
 115         || !SvIOK(*is_declarator_flag_ref)
 116         || !SvTRUE(*is_declarator_flag_ref))
 117     return o;
 118
 119   dd_flags = SvIVX(*is_declarator_flag_ref);
 120
 121 #ifdef DD_DEBUG
 122   printf("dd_flags are: %i\n", dd_flags);
 123 #endif
 124
 125   s = PL_bufptr; /* copy the current buffer pointer */
 126
 127   DD_DEBUG_S
 128
 129 #ifdef DD_DEBUG
 130   printf("PL_tokenbuf: %s\n", PL_tokenbuf);
 131 #endif
 132
 133   /*
 134    *   buffer will be at the beginning of the declarator, -unless- the
 135    *   declarator is at EOL in which case it'll be the next useful line
 136    *   so we don't short-circuit out if we don't find the declarator
 137    */
 138
 139   while (s < PL_bufend && isSPACE(*s)) s++;
 140   if (memEQ(s, PL_tokenbuf, strlen(PL_tokenbuf)))
 141     s += strlen(PL_tokenbuf);
 142
 143   DD_DEBUG_S
 144
 145   if (dd_flags & DD_HANDLE_NAME) {
 146
 147     /* find next word */
 148
 149     s = skipspace(s);
 150
 151     DD_DEBUG_S
 152
 153     /* arg 4 is allow_package */
 154
 155     s = scan_word(s, tmpbuf, sizeof tmpbuf, dd_flags & DD_HANDLE_PACKAGE, &len);
 156
 157     DD_DEBUG_S
 158
 159     if (len) {
 160       strcpy(found_name, tmpbuf);
 161 #ifdef DD_DEBUG
 162       printf("Found %s\n", found_name);
 163 #endif
 164     }
 165   }
 166
 167   if (dd_flags & DD_HANDLE_PROTO) {
 168
 169     s = skipspace(s);
 170
 171     if (*s == '(') { /* found a prototype-ish thing */
 172       save_s = s;
 173       s = scan_str(s, FALSE, FALSE); /* no keep_quoted, no keep_delims */
 174 #ifdef DD_HAS_TRAITS
 175       {
 176           char *traitstart = s = skipspace(s);
 177
 178           while (*s && *s != '{') ++s;
 179           if (*s) {
 180               int tlen = s - traitstart;
 181               Newx(found_traits, tlen+1, char);
 182               Copy(traitstart, found_traits, tlen, char);
 183               found_traits[tlen] = 0;
 184 #ifdef DD_DEBUG
 185               printf("found traits..... (%s)\n", found_traits);
 186 #endif
 187           }
 188       }
 189 #endif
 190
 191       if (SvPOK(PL_lex_stuff)) {
 192 #ifdef DD_DEBUG
 193         printf("Found proto %s\n", SvPVX(PL_lex_stuff));
 194 #endif
 195         found_proto = SvPVX(PL_lex_stuff);
 196         if (len) /* foo name () => foo name  X, only foo parsed so works */
 197           *save_s++ = ' ';
 198         else /* foo () => foo =X, TOKEN('&') won't handle foo X */
 199           *save_s++ = '=';
 200         *save_s++ = 'X';
 201         while (save_s < s) {
 202           *save_s++ = ' ';
 203         }
 204 #ifdef DD_DEBUG
 205         printf("Curbuf %s\n", PL_bufptr);
 206 #endif
 207       }
 208     }
 209   }
 210
 211   if (!len)
 212     found_name[0] = 0;
 213
 214 #ifdef DD_DEBUG
 215   printf("Calling init_declare\n");
 216 #endif
 217   cb_args[0] = HvNAME(stash);
 218   cb_args[1] = GvNAME(kGVOP_gv);
 219   cb_args[2] = HvNAME(PL_curstash);
 220   cb_args[3] = found_name;
 221   cb_args[4] = found_proto;
 222   cb_args[5] = found_traits;
 223   cb_args[6] = NULL;
 224
 225   if (len && found_proto)
 226     in_declare = 2;
 227   else if (len || found_proto)
 228     in_declare = 1;
 229   if (found_proto)
 230     PL_lex_stuff = Nullsv;
 231   s = skipspace(s);
 232 #ifdef DD_DEBUG
 233   printf("cur buf: %s\n", s);
 234   printf("bufend at: %i\n", PL_bufend - s);
 235   printf("linestr: %s\n", SvPVX(PL_linestr));
 236   printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
 237 #endif
 238   if (*s++ == '{') {
 239     call_argv("Devel::Declare::init_declare", G_SCALAR, cb_args);
 240     SPAGAIN;
 241     retstr = POPpx;
 242     PUTBACK;
 243     if (retstr && strlen(retstr)) {
 244       const char* old_start = SvPVX(PL_linestr);
 245       int start_diff;
 246       const int old_len = SvCUR(PL_linestr);
 247 #ifdef DD_DEBUG
 248       printf("Got string %s\n", retstr);
 249 #endif
 250       SvGROW(PL_linestr, (STRLEN)(old_len + strlen(retstr)));
 251       if (start_diff = SvPVX(PL_linestr) - old_start) {
 252 #ifdef DD_DEBUG
 253         printf("linestr realloc'ed, moving stuff about by %i\n", start_diff);
 254 #endif
 255         s += start_diff;
 256         PL_linestart += start_diff;
 257         PL_bufptr += start_diff;
 258         PL_bufend += start_diff;
 259         PL_oldbufptr += start_diff;
 260         PL_oldoldbufptr += start_diff;
 261         if (PL_last_lop)
 262           PL_last_lop += start_diff;
 263         if (PL_last_uni)
 264           PL_last_uni += start_diff;
 265       }
 266       memmove(s+strlen(retstr), s, (PL_bufend - s)+1);
 267       memmove(s, retstr, strlen(retstr));
 268       SvCUR_set(PL_linestr, old_len + strlen(retstr));
 269       PL_bufend += strlen(retstr);
 270 #ifdef DD_DEBUG
 271   printf("cur buf: %s\n", s);
 272   printf("PL_bufptr: %s\n", PL_bufptr);
 273   printf("bufend at: %i\n", PL_bufend - s);
 274   printf("linestr: %s\n", SvPVX(PL_linestr));
 275   printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
 276   printf("tokenbuf now: %s\n", PL_tokenbuf);
 277 #endif
 278     }
 279   } else {
 280     call_argv("Devel::Declare::init_declare", G_VOID|G_DISCARD, cb_args);
 281   }
 282   return o;
 283 }
 284
 285 STATIC OP *dd_ck_lineseq(pTHX_ OP *o) {
 286   AV* pad_inject_list;
 287   SV** to_inject_ref;
 288   int i, pad_inject_list_last;
 289
 290   o = dd_old_ck_lineseq(aTHX_ o);
 291
 292   pad_inject_list = get_av("Devel::Declare::next_pad_inject", FALSE);
 293   if (!pad_inject_list)
 294     return o;
 295
 296   pad_inject_list_last = av_len(pad_inject_list);
 297
 298   if (pad_inject_list_last == -1)
 299     return o;
 300
 301   for (i = 0; i <= pad_inject_list_last; i++) {
 302     to_inject_ref = av_fetch(pad_inject_list, i, FALSE);
 303     if (to_inject_ref && SvPOK(*to_inject_ref)) {
 304 #ifdef DD_DEBUG
 305   printf("Injecting %s into pad\n", SvPVX(*to_inject_ref));
 306 #endif
 307       allocmy(SvPVX(*to_inject_ref));
 308     }
 309   }
 310
 311   av_clear(pad_inject_list);
 312
 313   return o;
 314 }
 315
 316 static int initialized = 0;
 317
 318 MODULE = Devel::Declare  PACKAGE = Devel::Declare
 319
 320 PROTOTYPES: DISABLE
 321
 322 void
 323 setup()
 324   CODE:
 325   if (!initialized++) {
 326     dd_old_ck_rv2cv = PL_check[OP_RV2CV];
 327     PL_check[OP_RV2CV] = dd_ck_rv2cv;
 328     dd_old_ck_lineseq = PL_check[OP_LINESEQ];
 329     PL_check[OP_LINESEQ] = dd_ck_lineseq;
 330   }
 331
 332 void
 333 teardown()
 334   CODE:
 335   /* ensure we only uninit when number of teardown calls matches
 336      number of setup calls */
 337   if (initialized && !--initialized) {
 338     PL_check[OP_RV2CV] = dd_old_ck_rv2cv;
 339   }