https://perl5.git.perl.org / perl5.git / blame
| Commit | Line | Data |
|---|---|---|
| 34f7f30d SH |
1 | #ifndef isSLASH |
| 2 | #define isSLASH(c) ((c) == '/' || (c) == '\\') | |
| 3 | #define SKIP_SLASHES(s) \ | |
| 4 | STMT_START { \ | |
| 5 | while (*(s) && isSLASH(*(s))) \ | |
| 6 | ++(s); \ | |
| 7 | } STMT_END | |
| 8 | #define COPY_NONSLASHES(d,s) \ | |
| 9 | STMT_START { \ | |
| 10 | while (*(s) && !isSLASH(*(s))) \ | |
| 11 | *(d)++ = *(s)++; \ | |
| 12 | } STMT_END | |
| 13 | #endif | |
| 14 | ||
| 15 | /* Find the longname of a given path. path is destructively modified. | |
| 16 | * It should have space for at least MAX_PATH characters. */ | |
| 17 | ||
| 18 | CHAR_T * | |
| 19 | LONGPATH(CHAR_T *path) | |
| 20 | { | |
| 21 | WIN32_FIND_DATA_T fdata; | |
| 22 | HANDLE fhand; | |
| 23 | CHAR_T tmpbuf[MAX_PATH+1]; | |
| 24 | CHAR_T *tmpstart = tmpbuf; | |
| 25 | CHAR_T *start = path; | |
| 26 | CHAR_T sep; | |
| 27 | if (!path) | |
| 28 | return NULL; | |
| 29 | ||
| 30 | /* drive prefix */ | |
| 31 | if (isALPHA(path[0]) && path[1] == ':') { | |
| 32 | start = path + 2; | |
| cdf674e1 | 33 | *tmpstart++ = toupper(path[0]); |
| 34f7f30d SH |
34 | *tmpstart++ = ':'; |
| 35 | } | |
| 36 | /* UNC prefix */ | |
| 37 | else if (isSLASH(path[0]) && isSLASH(path[1])) { | |
| 38 | start = path + 2; | |
| 39 | *tmpstart++ = path[0]; | |
| 40 | *tmpstart++ = path[1]; | |
| 41 | SKIP_SLASHES(start); | |
| 42 | COPY_NONSLASHES(tmpstart,start); /* copy machine name */ | |
| 43 | if (*start) { | |
| 44 | *tmpstart++ = *start++; | |
| 45 | SKIP_SLASHES(start); | |
| 46 | COPY_NONSLASHES(tmpstart,start); /* copy share name */ | |
| 47 | } | |
| 48 | } | |
| 49 | *tmpstart = '\0'; | |
| 50 | while (*start) { | |
| 51 | /* copy initial slash, if any */ | |
| 52 | if (isSLASH(*start)) { | |
| 53 | *tmpstart++ = *start++; | |
| 54 | *tmpstart = '\0'; | |
| 55 | SKIP_SLASHES(start); | |
| 56 | } | |
| 57 | ||
| 58 | /* FindFirstFile() expands "." and "..", so we need to pass | |
| 59 | * those through unmolested */ | |
| 60 | if (*start == '.' | |
| 61 | && (!start[1] || isSLASH(start[1]) | |
| 62 | || (start[1] == '.' && (!start[2] || isSLASH(start[2]))))) | |
| 63 | { | |
| 64 | COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */ | |
| 65 | *tmpstart = '\0'; | |
| 66 | continue; | |
| 67 | } | |
| 68 | ||
| 69 | /* if this is the end, bust outta here */ | |
| 70 | if (!*start) | |
| 71 | break; | |
| 72 | ||
| 73 | /* now we're at a non-slash; walk up to next slash */ | |
| 74 | while (*start && !isSLASH(*start)) | |
| 75 | ++start; | |
| 76 | ||
| 77 | /* stop and find full name of component */ | |
| 78 | sep = *start; | |
| 79 | *start = '\0'; | |
| 80 | fhand = FN_FINDFIRSTFILE(path,&fdata); | |
| 81 | *start = sep; | |
| 82 | if (fhand != INVALID_HANDLE_VALUE) { | |
| 83 | STRLEN len = FN_STRLEN(fdata.cFileName); | |
| 84 | if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) { | |
| 85 | FN_STRCPY(tmpstart, fdata.cFileName); | |
| 86 | tmpstart += len; | |
| 87 | FindClose(fhand); | |
| 88 | } | |
| 89 | else { | |
| 90 | FindClose(fhand); | |
| 91 | errno = ERANGE; | |
| 92 | return NULL; | |
| 93 | } | |
| 94 | } | |
| 95 | else { | |
| 96 | /* failed a step, just return without side effects */ | |
| 97 | /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/ | |
| 98 | errno = EINVAL; | |
| 99 | return NULL; | |
| 100 | } | |
| 101 | } | |
| 102 | FN_STRCPY(path,tmpbuf); | |
| 103 | return path; | |
| 104 | } | |
| 105 | ||
| 106 | #undef CHAR_T | |
| 107 | #undef WIN32_FIND_DATA_T | |
| 108 | #undef FN_FINDFIRSTFILE | |
| 109 | #undef FN_STRLEN | |
| 110 | #undef FN_STRCPY | |
| 111 | #undef LONGPATH |