ext/File-Glob/Glob.xs

   1 #define PERL_NO_GET_CONTEXT
   2
   3 #include "EXTERN.h"
   4 #include "perl.h"
   5 #include "XSUB.h"
   6
   7 #include "bsd_glob.h"
   8
   9 #define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
  10
  11 typedef struct {
  12     int         x_GLOB_ERROR;
  13     HV *        x_GLOB_ENTRIES;
  14     Perl_ophook_t       x_GLOB_OLD_OPHOOK;
  15 } my_cxt_t;
  16
  17 START_MY_CXT
  18
  19 #define GLOB_ERROR      (MY_CXT.x_GLOB_ERROR)
  20
  21 #include "const-c.inc"
  22
  23 #ifdef WIN32
  24 #define errfunc         NULL
  25 #else
  26 static int
  27 errfunc(const char *foo, int bar) {
  28   PERL_UNUSED_ARG(foo);
  29   return !(bar == EACCES || bar == ENOENT || bar == ENOTDIR);
  30 }
  31 #endif
  32
  33 static void
  34 doglob(pTHX_ const char *pattern, int flags)
  35 {
  36     dSP;
  37     glob_t pglob;
  38     int i;
  39     int retval;
  40     SV *tmp;
  41     {
  42         dMY_CXT;
  43
  44         /* call glob */
  45         memset(&pglob, 0, sizeof(glob_t));
  46         retval = bsd_glob(pattern, flags, errfunc, &pglob);
  47         GLOB_ERROR = retval;
  48
  49         /* return any matches found */
  50         EXTEND(sp, pglob.gl_pathc);
  51         for (i = 0; i < pglob.gl_pathc; i++) {
  52             /* printf("# bsd_glob: %s\n", pglob.gl_pathv[i]); */
  53             tmp = newSVpvn_flags(pglob.gl_pathv[i], strlen(pglob.gl_pathv[i]),
  54                                  SVs_TEMP);
  55             TAINT;
  56             SvTAINT(tmp);
  57             PUSHs(tmp);
  58         }
  59         PUTBACK;
  60
  61         bsd_globfree(&pglob);
  62     }
  63 }
  64
  65 static void
  66 iterate(pTHX_ bool(*globber)(pTHX_ AV *entries, SV *patsv))
  67 {
  68     dSP;
  69     dMY_CXT;
  70
  71     const char * const cxixpv = (char *)&PL_op;
  72     STRLEN const cxixlen = sizeof(OP *);
  73     AV *entries;
  74     U32 const gimme = GIMME_V;
  75     SV *patsv = POPs;
  76     bool on_stack = FALSE;
  77
  78     if (!MY_CXT.x_GLOB_ENTRIES) MY_CXT.x_GLOB_ENTRIES = newHV();
  79     entries = (AV *)*(hv_fetch(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 1));
  80
  81     /* if we're just beginning, do it all first */
  82     if (SvTYPE(entries) != SVt_PVAV) {
  83         PUTBACK;
  84         on_stack = globber(aTHX_ entries, patsv);
  85         SPAGAIN;
  86     }
  87
  88     /* chuck it all out, quick or slow */
  89     if (gimme == G_ARRAY) {
  90         if (!on_stack) {
  91             EXTEND(SP, AvFILLp(entries)+1);
  92             Copy(AvARRAY(entries), SP+1, AvFILLp(entries)+1, SV *);
  93             SP += AvFILLp(entries)+1;
  94         }
  95         /* No G_DISCARD here!  It will free the stack items. */
  96         hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 0);
  97     }
  98     else {
  99         if (AvFILLp(entries) + 1) {
 100             mPUSHs(av_shift(entries));
 101         }
 102         else {
 103             /* return undef for EOL */
 104             hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, G_DISCARD);
 105             PUSHs(&PL_sv_undef);
 106         }
 107     }
 108     PUTBACK;
 109 }
 110
 111 /* returns true if the items are on the stack already, but only in
 112    list context */
 113 static bool
 114 csh_glob(pTHX_ AV *entries, SV *patsv)
 115 {
 116         dSP;
 117         const char *pat;
 118         AV *patav = NULL;
 119         const char *patend;
 120         const char *s = NULL;
 121         const char *piece = NULL;
 122         SV *word = NULL;
 123         int const flags =
 124             (int)SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
 125         bool is_utf8;
 126         STRLEN len;
 127         U32 const gimme = GIMME_V;
 128
 129         /* glob without args defaults to $_ */
 130         SvGETMAGIC(patsv);
 131         if (
 132             !SvOK(patsv)
 133          && (patsv = DEFSV, SvGETMAGIC(patsv), !SvOK(patsv))
 134         )
 135              pat = "", len = 0, is_utf8 = 0;
 136         else pat = SvPV_nomg(patsv,len), is_utf8 = !!SvUTF8(patsv);
 137         patend = pat + len;
 138
 139         /* extract patterns */
 140         s = pat-1;
 141         while (++s < patend) {
 142             switch (*s) {
 143             case '\'':
 144             case '"' :
 145               {
 146                 bool found = FALSE;
 147                 const char quote = *s;
 148                 if (!word) {
 149                     word = newSVpvs("");
 150                     if (is_utf8) SvUTF8_on(word);
 151                 }
 152                 if (piece) sv_catpvn(word, piece, s-piece);
 153                 piece = s+1;
 154                 while (++s < patend)
 155                     if (*s == '\\') {
 156                         s++;
 157                         /* If the backslash is here to escape a quote,
 158                            obliterate it. */
 159                         if (s < patend && *s == quote)
 160                             sv_catpvn(word, piece, s-piece-1), piece = s;
 161                     }
 162                     else if (*s == quote) {
 163                         sv_catpvn(word, piece, s-piece);
 164                         piece = NULL;
 165                         found = TRUE;
 166                         break;
 167                     }
 168                 if (!found) { /* unmatched quote */
 169                     /* Give up on tokenisation and treat the whole string
 170                        as a single token, but with whitespace stripped. */
 171                     piece = pat;
 172                     while (isSPACE(*pat)) pat++;
 173                     while (isSPACE(*(patend-1))) patend--;
 174                     /* bsd_glob expects a trailing null, but we cannot mod-
 175                        ify the original */
 176                     if (patend < SvEND(patsv)) {
 177                         if (word) sv_setpvn(word, pat, patend-pat);
 178                         else
 179                             word = newSVpvn_flags(
 180                                 pat, patend-pat, SVf_UTF8*is_utf8
 181                             );
 182                         piece = NULL;
 183                     }
 184                     else {
 185                         if (word) SvREFCNT_dec(word), word=NULL;
 186                         piece = pat;
 187                         s = patend;
 188                     }
 189                     goto end_of_parsing;
 190                 }
 191                 break;
 192               }
 193             case '\\':
 194                 if (!piece) piece = s;
 195                 s++;
 196                 /* If the backslash is here to escape a quote,
 197                    obliterate it. */
 198                 if (s < patend && (*s == '"' || *s == '\'')) {
 199                     if (!word) {
 200                         word = newSVpvn(piece,s-piece-1);
 201                         if (is_utf8) SvUTF8_on(word);
 202                     }
 203                     else sv_catpvn(word, piece, s-piece-1);
 204                     piece = s;
 205                 }
 206                 break;
 207             default:
 208                 if (isSPACE(*s)) {
 209                     if (piece) {
 210                         if (!word) {
 211                             word = newSVpvn(piece,s-piece);
 212                             if (is_utf8) SvUTF8_on(word);
 213                         }
 214                         else sv_catpvn(word, piece, s-piece);
 215                     }
 216                     if (!word) break;
 217                     if (!patav) patav = (AV *)sv_2mortal((SV *)newAV());
 218                     av_push(patav, word);
 219                     word = NULL;
 220                     piece = NULL;
 221                 }
 222                 else if (!piece) piece = s;
 223                 break;
 224             }
 225         }
 226       end_of_parsing:
 227
 228         assert(SvTYPE(entries) != SVt_PVAV);
 229         sv_upgrade((SV *)entries, SVt_PVAV);
 230         if (!IS_SAFE_SYSCALL(patsv, "pattern", "glob"))
 231             return FALSE;
 232
 233         if (patav) {
 234             I32 items = AvFILLp(patav) + 1;
 235             SV **svp = AvARRAY(patav);
 236             while (items--) {
 237                 PUSHMARK(SP);
 238                 PUTBACK;
 239                 doglob(aTHX_ SvPVXx(*svp++), flags);
 240                 SPAGAIN;
 241                 {
 242                     dMARK;
 243                     dORIGMARK;
 244                     while (++MARK <= SP)
 245                         av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
 246                     SP = ORIGMARK;
 247                 }
 248             }
 249         }
 250         /* piece is set at this point if there is no trailing whitespace.
 251            It is the beginning of the last token or quote-delimited
 252            piece thereof.  word is set at this point if the last token has
 253            multiple quoted pieces. */
 254         if (piece || word) {
 255             if (word) {
 256                 if (piece) sv_catpvn(word, piece, s-piece);
 257                 piece = SvPVX(word);
 258             }
 259             PUSHMARK(SP);
 260             PUTBACK;
 261             doglob(aTHX_ piece, flags);
 262             if (word) SvREFCNT_dec(word);
 263             SPAGAIN;
 264             {
 265                 dMARK;
 266                 dORIGMARK;
 267                 /* short-circuit here for a fairly common case */
 268                 if (!patav && gimme == G_ARRAY) { PUTBACK; return TRUE; }
 269                 while (++MARK <= SP)
 270                     av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
 271
 272                 SP = ORIGMARK;
 273             }
 274         }
 275         PUTBACK;
 276         return FALSE;
 277 }
 278
 279 static void
 280 csh_glob_iter(pTHX)
 281 {
 282     iterate(aTHX_ csh_glob);
 283 }
 284
 285 /* wrapper around doglob that can be passed to the iterator */
 286 static bool
 287 doglob_iter_wrapper(pTHX_ AV *entries, SV *patsv)
 288 {
 289     dSP;
 290     const char *pattern;
 291     int const flags =
 292             (int)SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
 293
 294     SvGETMAGIC(patsv);
 295     if (
 296             !SvOK(patsv)
 297          && (patsv = DEFSV, SvGETMAGIC(patsv), !SvOK(patsv))
 298     )
 299          pattern = "";
 300     else pattern = SvPV_nomg_nolen(patsv);
 301
 302     PUSHMARK(SP);
 303     PUTBACK;
 304     doglob(aTHX_ pattern, flags);
 305     SPAGAIN;
 306     {
 307         dMARK;
 308         dORIGMARK;
 309         if (GIMME_V == G_ARRAY) { PUTBACK; return TRUE; }
 310         sv_upgrade((SV *)entries, SVt_PVAV);
 311         while (++MARK <= SP)
 312             av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
 313         SP = ORIGMARK;
 314     }
 315     return FALSE;
 316 }
 317
 318 static void
 319 glob_ophook(pTHX_ OP *o)
 320 {
 321   if (PL_dirty) return;
 322   {
 323     dMY_CXT;
 324     if (MY_CXT.x_GLOB_ENTRIES
 325      && (o->op_type == OP_GLOB || o->op_type == OP_ENTERSUB))
 326         hv_delete(MY_CXT.x_GLOB_ENTRIES, (char *)&o, sizeof(OP *),
 327                   G_DISCARD);
 328     if (MY_CXT.x_GLOB_OLD_OPHOOK) MY_CXT.x_GLOB_OLD_OPHOOK(aTHX_ o);
 329   }
 330 }
 331
 332 MODULE = File::Glob             PACKAGE = File::Glob
 333
 334 int
 335 GLOB_ERROR()
 336     PREINIT:
 337         dMY_CXT;
 338     CODE:
 339         RETVAL = GLOB_ERROR;
 340     OUTPUT:
 341         RETVAL
 342
 343 void
 344 bsd_glob(pattern,...)
 345     char *pattern
 346 PREINIT:
 347     int flags = 0;
 348 PPCODE:
 349     {
 350         /* allow for optional flags argument */
 351         if (items > 1) {
 352             flags = (int) SvIV(ST(1));
 353             /* remove unsupported flags */
 354             flags &= ~(GLOB_APPEND | GLOB_DOOFFS | GLOB_ALTDIRFUNC | GLOB_MAGCHAR);
 355         } else {
 356             flags = (int) SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
 357         }
 358
 359         PUTBACK;
 360         doglob(aTHX_ pattern, flags);
 361         SPAGAIN;
 362     }
 363
 364 PROTOTYPES: DISABLE
 365 void
 366 csh_glob(...)
 367 PPCODE:
 368     /* For backward-compatibility with the original Perl function, we sim-
 369      * ply take the first argument, regardless of how many there are.
 370      */
 371     if (items) SP ++;
 372     else {
 373         XPUSHs(&PL_sv_undef);
 374     }
 375     PUTBACK;
 376     csh_glob_iter(aTHX);
 377     SPAGAIN;
 378
 379 void
 380 bsd_glob_override(...)
 381 PPCODE:
 382     if (items) SP ++;
 383     else {
 384         XPUSHs(&PL_sv_undef);
 385     }
 386     PUTBACK;
 387     iterate(aTHX_ doglob_iter_wrapper);
 388     SPAGAIN;
 389
 390 BOOT:
 391 {
 392 #ifndef PERL_EXTERNAL_GLOB
 393     /* Don't do this at home! The globhook interface is highly volatile. */
 394     PL_globhook = csh_glob_iter;
 395 #endif
 396 }
 397
 398 BOOT:
 399 {
 400     MY_CXT_INIT;
 401     {
 402         dMY_CXT;
 403         MY_CXT.x_GLOB_ENTRIES = NULL;
 404         MY_CXT.x_GLOB_OLD_OPHOOK = PL_opfreehook;
 405         PL_opfreehook = glob_ophook;
 406     }
 407 }
 408
 409 INCLUDE: const-xs.inc