perl/vms/vms.c

169 static char *mp_do_tovmspath(pTHX_ const char *path, char *buf, int ts, int *);
170 static char *mp_do_tounixpath(pTHX_ const char *path, char *buf, int ts, int *);
179    (const char *path, char *buf, int dir_flag, int * utf8_flag);
182 static char * int_tovmspath(const char *path, char *buf, int * utf8_fl);
301 is_unix_filespec(const char *path)
307     if (! strBEGINs(path,"\"^UP^")) {
308         pch1 = strchr(path, '/');
315               if (strEQ(path,"."))
651  * parse a VMS path specification into components.
655  * path.
658 vms_split_path(const char * path, char * * volume, int * vol_len, char * * root, int * root_len,
690     path_desc.dsc$a_pointer = (char *)path; /* cast ok */
691     path_desc.dsc$w_length = strlen(path);
3709             /* It could be a UNIX path */
5996 **   pathify_dirspec() - convert a directory spec into a path (i.e.
6000 **   tounixpath() - convert a directory spec into a Unix-style path.
6001 **   tovmspath() - convert a directory spec into a VMS-style path.
6119       if (dirlen && trndir[dirlen-1] == '/') {    /* path ends with '/'; just add .dir;1 */
6413         /* There's more than one directory in the path.  Just roll back. */
6489         else {  /* This is a top-level dir.  Add the MFD to the path. */
6631                          * Valid would have followed is_dir path above.
6667 /* path specification.  No utf8 flag because it is not changed or used */
6960 /*{{{ char *pathify_dirspec[_ts](char *path, char *buf)*/
7448  This procedure is used to identify if a path is based in either
7783   /* Start with the UNIX path */
7819             /* Split up the path to find the components */
8023       /* This is verified to be a real path */
8060     } /* end of verified real path handling */
8155   } /* End of relative/absolute path handling */
8405 /*{{{ char *tovmsspec[_ts](char *path, char *buf, int * utf8_flag)*/
8407 int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag)
8420       if (path == NULL)
8421           fprintf(stderr, "int_tovmsspec: path = NULL\n");
8423           fprintf(stderr, "int_tovmsspec: path = %s\n", path);
8426   if (path == NULL) {
8435   if (path[0] == '.') {
8436     if (path[1] == '\0') {
8443       if (path[1] == '.' && path[2] == '\0') {
8456     if (strBEGINs(path,"\"^UP^")) {
8457       posix_to_vmsspec_hardway(rslt, rslt_len, path, dir_flag, utf8_flag);
8465        (path,
8493       my_strlcpy(rslt, path, VMS_MAXRSS);
8514     my_strlcpy(rslt, path, VMS_MAXRSS);
8521   dirend = strrchr(path,'/');
8530       if (strstr(path, "$(")) {
8531           my_strlcpy(rslt, path, VMS_MAXRSS);
8546   cp2 = path;
8592         cp2 = path;
8612     /* If the first element of the path is a logical name, determine
8739         if (cp2 >= path && (cp2 == path || *(cp2-1) != '^')) /* not previously escaped */
8823         if (cp2 >= path && *(cp2-1) != '^') /* not previously escaped */
8868 /*{{{ char *tovmsspec[_ts](char *path, char *buf, int * utf8_flag)*/
8870 mp_do_tovmsspec(pTHX_ const char *path, char *buf, int ts, int dir_flag, int * utf8_flag)
8888     ret_spec = int_tovmsspec(path, ret_buf, 0, utf8_flag);
8902 Perl_tovmsspec(pTHX_ const char *path, char *buf)
8904     return do_tovmsspec(path, buf, 0, NULL);
8908 Perl_tovmsspec_ts(pTHX_ const char *path, char *buf)
8910     return do_tovmsspec(path, buf, 1, NULL);
8914 Perl_tovmsspec_utf8(pTHX_ const char *path, char *buf, int * utf8_fl)
8916     return do_tovmsspec(path, buf, 0, utf8_fl);
8920 Perl_tovmsspec_utf8_ts(pTHX_ const char *path, char *buf, int * utf8_fl)
8922     return do_tovmsspec(path, buf, 1, utf8_fl);
8925 /*{{{ char *int_tovmspath(char *path, char *buf, const int *)*/
8928 int_tovmspath(const char *path, char *buf, int * utf8_fl)
8932     if (path == NULL)
8939     ret_spec = int_pathify_dirspec(path, pathified);
8953 /*{{{ char *tovmspath[_ts](char *path, char *buf, const int *)*/
8955 mp_do_tovmspath(pTHX_ const char *path, char *buf, int ts, int * utf8_fl)
8961   if (path == NULL) return NULL;
8964   if (int_pathify_dirspec(path, pathified) == NULL) {
8999 Perl_tovmspath(pTHX_ const char *path, char *buf)
9001     return do_tovmspath(path, buf, 0, NULL);
9005 Perl_tovmspath_ts(pTHX_ const char *path, char *buf)
9007     return do_tovmspath(path, buf, 1, NULL);
9011 Perl_tovmspath_utf8(pTHX_ const char *path, char *buf, int *utf8_fl)
9013     return do_tovmspath(path, buf, 0, utf8_fl);
9017 Perl_tovmspath_utf8_ts(pTHX_ const char *path, char *buf, int *utf8_fl)
9019     return do_tovmspath(path, buf, 1, utf8_fl);
9023 /*{{{ char *tounixpath[_ts](char *path, char *buf, int * utf8_fl)*/
9025 mp_do_tounixpath(pTHX_ const char *path, char *buf, int ts, int * utf8_fl)
9031   if (path == NULL) return NULL;
9034   if (int_pathify_dirspec(path, pathified) == NULL) {
9070 Perl_tounixpath(pTHX_ const char *path, char *buf)
9072     return do_tounixpath(path, buf, 0, NULL);
9076 Perl_tounixpath_ts(pTHX_ const char *path, char *buf)
9078     return do_tounixpath(path, buf, 1, NULL);
9082 Perl_tounixpath_utf8(pTHX_ const char *path, char *buf, int * utf8_fl)
9084     return do_tounixpath(path, buf, 0, utf8_fl);
9088 Perl_tounixpath_utf8_ts(pTHX_ const char *path, char *buf, int * utf8_fl)
9090     return do_tounixpath(path, buf, 1, utf8_fl);
9803  * full path).  Note that returned filespec is Unix-style, regardless
9851   /* No prefix or absolute path on wildcard, so nothing to remove */
9873       if ((*cp1 == '/') && !dirs--) /* postdec so we get front of rel path */
9898        * ellipsis weren't there (i.e. return shortest possible path that
9921     /* First off, back up over constant elements at end of path */
9947     /* Now skip over each ellipsis and try to match the path in front of it. */
11700 /*{{{int my_utime(const char *path, const struct utimbuf *utimes)*/
11730  * a Unix-style path ending in a directory name (e.g. dir1/dir2/dir3)
13059             /* path delimiter of ':>]', if so, then the old behavior has */
13664                     /*    Otherwise, get the real path for the parent */
13963     /* The path separator in PERL5LIB is '|' unless running under a Unix shell. */