This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
007990de60d09467b9e72485295e363977307f08
[perl5.git] / ext / Win32 / longpath.inc
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;
33         *tmpstart++ = path[0];
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