1: /*
  2:     We define the string operations here. The reason we just do not use
  3:   the standard string routines in the PETSc code is that on some machines
  4:   they are broken or have the wrong prototypes.

  6: */
  7: #include <petscsys.h>
  8: #if defined(PETSC_HAVE_STRINGS_H)
  9: #  include <strings.h>          /* strcasecmp */
 10: #endif

 12: /*@C
 13:    PetscStrToArray - Separates a string by a character (for example ' ' or '\n') and creates an array of strings

 15:    Not Collective

 17:    Input Parameters:
 18: +  s - pointer to string
 19: -  sp - separator character

 21:    Output Parameters:
 22: +   argc - the number of entries in the array
 23: -   args - an array of the entries with a null at the end

 25:    Level: intermediate

 27:    Notes:
 28:     this may be called before PetscInitialize() or after PetscFinalize()

 30:    Not for use in Fortran

 32:    Developer Notes:
 33:     Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
 34:      to generate argc, args arguments passed to MPI_Init()

 36: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()

 38: @*/
 39: PetscErrorCode  PetscStrToArray(const char s[],char sp,int *argc,char ***args)
 40: {
 41:   int       i,j,n,*lens,cnt = 0;
 42:   PetscBool flg = PETSC_FALSE;

 44:   if (!s) n = 0;
 45:   else    n = strlen(s);
 46:   *argc = 0;
 47:   *args = NULL;
 48:   for (; n>0; n--) {   /* remove separator chars at the end - and will empty the string if all chars are separator chars */
 49:     if (s[n-1] != sp) break;
 50:   }
 51:   if (!n) {
 52:     return(0);
 53:   }
 54:   for (i=0; i<n; i++) {
 55:     if (s[i] != sp) break;
 56:   }
 57:   for (;i<n+1; i++) {
 58:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
 59:     else if (s[i] != sp) {flg = PETSC_FALSE;}
 60:   }
 61:   (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
 62:   lens    = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
 63:   for (i=0; i<*argc; i++) lens[i] = 0;

 65:   *argc = 0;
 66:   for (i=0; i<n; i++) {
 67:     if (s[i] != sp) break;
 68:   }
 69:   for (;i<n+1; i++) {
 70:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
 71:     else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
 72:   }

 74:   for (i=0; i<*argc; i++) {
 75:     (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
 76:     if (!(*args)[i]) {
 77:       free(lens);
 78:       for (j=0; j<i; j++) free((*args)[j]);
 79:       free(*args);
 80:       return PETSC_ERR_MEM;
 81:     }
 82:   }
 83:   free(lens);
 84:   (*args)[*argc] = NULL;

 86:   *argc = 0;
 87:   for (i=0; i<n; i++) {
 88:     if (s[i] != sp) break;
 89:   }
 90:   for (;i<n+1; i++) {
 91:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
 92:     else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
 93:   }
 94:   return 0;
 95: }

 97: /*@C
 98:    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().

100:    Not Collective

102:    Output Parameters:
103: +  argc - the number of arguments
104: -  args - the array of arguments

106:    Level: intermediate

108:    Notes:
109:     This may be called before PetscInitialize() or after PetscFinalize()

111:    Not for use in Fortran

113: .seealso: PetscStrToArray()

115: @*/
116: PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
117: {
118:   PetscInt i;

120:   for (i=0; i<argc; i++) free(args[i]);
121:   if (args) free(args);
122:   return 0;
123: }

125: /*@C
126:    PetscStrlen - Gets length of a string

128:    Not Collective

130:    Input Parameters:
131: .  s - pointer to string

133:    Output Parameter:
134: .  len - length in bytes

136:    Level: intermediate

138:    Note:
139:    This routine is analogous to strlen().

141:    Null string returns a length of zero

143:    Not for use in Fortran

145: @*/
146: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
147: {
149:   if (!s) *len = 0;
150:   else    *len = strlen(s);
151:   return(0);
152: }

154: /*@C
155:    PetscStrallocpy - Allocates space to hold a copy of a string then copies the string

157:    Not Collective

159:    Input Parameters:
160: .  s - pointer to string

162:    Output Parameter:
163: .  t - the copied string

165:    Level: intermediate

167:    Note:
168:       Null string returns a new null string

170:       Not for use in Fortran

172:       Warning: If t has previously been allocated then that memory is lost, you may need to PetscFree()
173:       the array before calling this routine.

175: .seealso: PetscStrArrayallocpy(), PetscStrcpy(), PetscStrNArrayallocpy()

177: @*/
178: PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
179: {
181:   size_t         len;
182:   char           *tmp = NULL;

185:   if (s) {
186:     PetscStrlen(s,&len);
187:     PetscMalloc1(1+len,&tmp);
188:     PetscStrcpy(tmp,s);
189:   }
190:   *t = tmp;
191:   return(0);
192: }

194: /*@C
195:    PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings

197:    Not Collective

199:    Input Parameters:
200: .  s - pointer to array of strings (final string is a null)

202:    Output Parameter:
203: .  t - the copied array string

205:    Level: intermediate

207:    Note:
208:       Not for use in Fortran

210:       Warning: If t has previously been allocated then that memory is lost, you may need to PetscStrArrayDestroy()
211:       the array before calling this routine.

213: .seealso: PetscStrallocpy(), PetscStrArrayDestroy(), PetscStrNArrayallocpy()

215: @*/
216: PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
217: {
219:   PetscInt       i,n = 0;

222:   while (list[n++]) ;
223:   PetscMalloc1(n+1,t);
224:   for (i=0; i<n; i++) {
225:     PetscStrallocpy(list[i],(*t)+i);
226:   }
227:   (*t)[n] = NULL;
228:   return(0);
229: }

231: /*@C
232:    PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().

234:    Not Collective

236:    Output Parameters:
237: .   list - array of strings

239:    Level: intermediate

241:    Notes:
242:     Not for use in Fortran

244: .seealso: PetscStrArrayallocpy()

246: @*/
247: PetscErrorCode PetscStrArrayDestroy(char ***list)
248: {
249:   PetscInt       n = 0;

253:   if (!*list) return(0);
254:   while ((*list)[n]) {
255:     PetscFree((*list)[n]);
256:     n++;
257:   }
258:   PetscFree(*list);
259:   return(0);
260: }

262: /*@C
263:    PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings

265:    Not Collective

267:    Input Parameters:
268: +  n - the number of string entries
269: -  s - pointer to array of strings

271:    Output Parameter:
272: .  t - the copied array string

274:    Level: intermediate

276:    Note:
277:       Not for use in Fortran

279: .seealso: PetscStrallocpy(), PetscStrArrayallocpy(), PetscStrNArrayDestroy()

281: @*/
282: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
283: {
285:   PetscInt       i;

288:   PetscMalloc1(n,t);
289:   for (i=0; i<n; i++) {
290:     PetscStrallocpy(list[i],(*t)+i);
291:   }
292:   return(0);
293: }

295: /*@C
296:    PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().

298:    Not Collective

300:    Output Parameters:
301: +   n - number of string entries
302: -   list - array of strings

304:    Level: intermediate

306:    Notes:
307:     Not for use in Fortran

309: .seealso: PetscStrArrayallocpy()

311: @*/
312: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
313: {
315:   PetscInt       i;

318:   if (!*list) return(0);
319:   for (i=0; i<n; i++) {
320:     PetscFree((*list)[i]);
321:   }
322:   PetscFree(*list);
323:   return(0);
324: }

326: /*@C
327:    PetscStrcpy - Copies a string

329:    Not Collective

331:    Input Parameters:
332: .  t - pointer to string

334:    Output Parameter:
335: .  s - the copied string

337:    Level: intermediate

339:    Notes:
340:      Null string returns a string starting with zero

342:      Not for use in Fortran

344:      It is recommended you use PetscStrncpy() instead of this routine

346: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrlcat()

348: @*/

350: PetscErrorCode  PetscStrcpy(char s[],const char t[])
351: {
353:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
354:   if (t) strcpy(s,t);
355:   else if (s) s[0] = 0;
356:   return(0);
357: }

359: /*@C
360:    PetscStrncpy - Copies a string up to a certain length

362:    Not Collective

364:    Input Parameters:
365: +  t - pointer to string
366: -  n - the length to copy

368:    Output Parameter:
369: .  s - the copied string

371:    Level: intermediate

373:    Note:
374:      Null string returns a string starting with zero

376:      If the string that is being copied is of length n or larger then the entire string is not
377:      copied and the final location of s is set to NULL. This is different then the behavior of
378:      strncpy() which leaves s non-terminated if there is not room for the entire string.

380:   Developers Note: Should this be PetscStrlcpy() to reflect its behavior which is like strlcpy() not strncpy()

382: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrlcat()

384: @*/
385: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
386: {
388:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
389:   if (s && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Requires an output string of length at least 1 to hold the termination character");
390:   if (t) {
391:     if (n > 1) {
392:       strncpy(s,t,n-1);
393:       s[n-1] = '\0';
394:     } else {
395:       s[0] = '\0';
396:     }
397:   } else if (s) s[0] = 0;
398:   return(0);
399: }

401: /*@C
402:    PetscStrcat - Concatenates a string onto a given string

404:    Not Collective

406:    Input Parameters:
407: +  s - string to be added to
408: -  t - pointer to string to be added to end

410:    Level: intermediate

412:    Notes:
413:     Not for use in Fortran

415:     It is recommended you use PetscStrlcat() instead of this routine

417: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrlcat()

419: @*/
420: PetscErrorCode  PetscStrcat(char s[],const char t[])
421: {
423:   if (!t) return(0);
424:   strcat(s,t);
425:   return(0);
426: }

428: /*@C
429:    PetscStrlcat - Concatenates a string onto a given string, up to a given length

431:    Not Collective

433:    Input Parameters:
434: +  s - pointer to string to be added to at end
435: .  t - string to be added
436: -  n - length of the original allocated string

438:    Level: intermediate

440:   Notes:
441:   Not for use in Fortran

443:   Unlike the system call strncat(), the length passed in is the length of the
444:   original allocated space, not the length of the left-over space. This is
445:   similar to the BSD system call strlcat().

447: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()

449: @*/
450: PetscErrorCode  PetscStrlcat(char s[],const char t[],size_t n)
451: {
452:   size_t         len;

456:   if (t && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
457:   if (!t) return(0);
458:   PetscStrlen(t,&len);
459:   strncat(s,t,n - len);
460:   s[n-1] = 0;
461:   return(0);
462: }

464: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
465: {
466:   int c;

468:   if (!a && !b)      *flg = PETSC_TRUE;
469:   else if (!a || !b) *flg = PETSC_FALSE;
470:   else {
471:     c = strcmp(a,b);
472:     if (c) *flg = PETSC_FALSE;
473:     else   *flg = PETSC_TRUE;
474:   }
475: }

477: /*@C
478:    PetscStrcmp - Compares two strings,

480:    Not Collective

482:    Input Parameters:
483: +  a - pointer to string first string
484: -  b - pointer to second string

486:    Output Parameter:
487: .  flg - PETSC_TRUE if the two strings are equal

489:    Level: intermediate

491:    Notes:
492:     Not for use in Fortran

494: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()

496: @*/
497: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
498: {
499:   int c;

502:   if (!a && !b)      *flg = PETSC_TRUE;
503:   else if (!a || !b) *flg = PETSC_FALSE;
504:   else {
505:     c = strcmp(a,b);
506:     if (c) *flg = PETSC_FALSE;
507:     else   *flg = PETSC_TRUE;
508:   }
509:   return(0);
510: }

512: /*@C
513:    PetscStrgrt - If first string is greater than the second

515:    Not Collective

517:    Input Parameters:
518: +  a - pointer to first string
519: -  b - pointer to second string

521:    Output Parameter:
522: .  flg - if the first string is greater

524:    Notes:
525:     Null arguments are ok, a null string is considered smaller than
526:     all others

528:    Not for use in Fortran

530:    Level: intermediate

532: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()

534: @*/
535: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
536: {
537:   int c;

540:   if (!a && !b) *t = PETSC_FALSE;
541:   else if (a && !b) *t = PETSC_TRUE;
542:   else if (!a && b) *t = PETSC_FALSE;
543:   else {
544:     c = strcmp(a,b);
545:     if (c > 0) *t = PETSC_TRUE;
546:     else       *t = PETSC_FALSE;
547:   }
548:   return(0);
549: }

551: /*@C
552:    PetscStrcasecmp - Returns true if the two strings are the same
553:      except possibly for case.

555:    Not Collective

557:    Input Parameters:
558: +  a - pointer to first string
559: -  b - pointer to second string

561:    Output Parameter:
562: .  flg - if the two strings are the same

564:    Notes:
565:     Null arguments are ok

567:    Not for use in Fortran

569:    Level: intermediate

571: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()

573: @*/
574: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
575: {
576:   int c;

579:   if (!a && !b) c = 0;
580:   else if (!a || !b) c = 1;
581: #if defined(PETSC_HAVE_STRCASECMP)
582:   else c = strcasecmp(a,b);
583: #elif defined(PETSC_HAVE_STRICMP)
584:   else c = stricmp(a,b);
585: #else
586:   else {
587:     char           *aa,*bb;
589:     PetscStrallocpy(a,&aa);
590:     PetscStrallocpy(b,&bb);
591:     PetscStrtolower(aa);
592:     PetscStrtolower(bb);
593:     PetscStrcmp(aa,bb,t);
594:     PetscFree(aa);
595:     PetscFree(bb);
596:     return(0);
597:   }
598: #endif
599:   if (!c) *t = PETSC_TRUE;
600:   else    *t = PETSC_FALSE;
601:   return(0);
602: }

604: /*@C
605:    PetscStrncmp - Compares two strings, up to a certain length

607:    Not Collective

609:    Input Parameters:
610: +  a - pointer to first string
611: .  b - pointer to second string
612: -  n - length to compare up to

614:    Output Parameter:
615: .  t - if the two strings are equal

617:    Level: intermediate

619:    Notes:
620:     Not for use in Fortran

622: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()

624: @*/
625: PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
626: {
627:   int c;

630:   c = strncmp(a,b,n);
631:   if (!c) *t = PETSC_TRUE;
632:   else    *t = PETSC_FALSE;
633:   return(0);
634: }

636: /*@C
637:    PetscStrchr - Locates first occurrence of a character in a string

639:    Not Collective

641:    Input Parameters:
642: +  a - pointer to string
643: -  b - character

645:    Output Parameter:
646: .  c - location of occurrence, NULL if not found

648:    Level: intermediate

650:    Notes:
651:     Not for use in Fortran

653: @*/
654: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
655: {
657:   *c = (char*)strchr(a,b);
658:   return(0);
659: }

661: /*@C
662:    PetscStrrchr - Locates one location past the last occurrence of a character in a string,
663:       if the character is not found then returns entire string

665:    Not Collective

667:    Input Parameters:
668: +  a - pointer to string
669: -  b - character

671:    Output Parameter:
672: .  tmp - location of occurrence, a if not found

674:    Level: intermediate

676:    Notes:
677:     Not for use in Fortran

679: @*/
680: PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
681: {
683:   *tmp = (char*)strrchr(a,b);
684:   if (!*tmp) *tmp = (char*)a;
685:   else *tmp = *tmp + 1;
686:   return(0);
687: }

689: /*@C
690:    PetscStrtolower - Converts string to lower case

692:    Not Collective

694:    Input Parameters:
695: .  a - pointer to string

697:    Level: intermediate

699:    Notes:
700:     Not for use in Fortran

702: @*/
703: PetscErrorCode  PetscStrtolower(char a[])
704: {
706:   while (*a) {
707:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
708:     a++;
709:   }
710:   return(0);
711: }

713: /*@C
714:    PetscStrtoupper - Converts string to upper case

716:    Not Collective

718:    Input Parameters:
719: .  a - pointer to string

721:    Level: intermediate

723:    Notes:
724:     Not for use in Fortran

726: @*/
727: PetscErrorCode  PetscStrtoupper(char a[])
728: {
730:   while (*a) {
731:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
732:     a++;
733:   }
734:   return(0);
735: }

737: /*@C
738:    PetscStrendswith - Determines if a string ends with a certain string

740:    Not Collective

742:    Input Parameters:
743: +  a - pointer to string
744: -  b - string to endwith

746:    Output Parameter:
747: .  flg - PETSC_TRUE or PETSC_FALSE

749:    Notes:
750:     Not for use in Fortran

752:    Level: intermediate

754: @*/
755: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
756: {
757:   char           *test;
759:   size_t         na,nb;

762:   *flg = PETSC_FALSE;
763:   PetscStrrstr(a,b,&test);
764:   if (test) {
765:     PetscStrlen(a,&na);
766:     PetscStrlen(b,&nb);
767:     if (a+na-nb == test) *flg = PETSC_TRUE;
768:   }
769:   return(0);
770: }

772: /*@C
773:    PetscStrbeginswith - Determines if a string begins with a certain string

775:    Not Collective

777:    Input Parameters:
778: +  a - pointer to string
779: -  b - string to begin with

781:    Output Parameter:
782: .  flg - PETSC_TRUE or PETSC_FALSE

784:    Notes:
785:     Not for use in Fortran

787:    Level: intermediate

789: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
790:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()

792: @*/
793: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
794: {
795:   char           *test;

799:   *flg = PETSC_FALSE;
800:   PetscStrrstr(a,b,&test);
801:   if (test && (test == a)) *flg = PETSC_TRUE;
802:   return(0);
803: }

805: /*@C
806:    PetscStrendswithwhich - Determines if a string ends with one of several possible strings

808:    Not Collective

810:    Input Parameters:
811: +  a - pointer to string
812: -  bs - strings to end with (last entry must be NULL)

814:    Output Parameter:
815: .  cnt - the index of the string it ends with or the index of NULL

817:    Notes:
818:     Not for use in Fortran

820:    Level: intermediate

822: @*/
823: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
824: {
825:   PetscBool      flg;

829:   *cnt = 0;
830:   while (bs[*cnt]) {
831:     PetscStrendswith(a,bs[*cnt],&flg);
832:     if (flg) return(0);
833:     *cnt += 1;
834:   }
835:   return(0);
836: }

838: /*@C
839:    PetscStrrstr - Locates last occurrence of string in another string

841:    Not Collective

843:    Input Parameters:
844: +  a - pointer to string
845: -  b - string to find

847:    Output Parameter:
848: .  tmp - location of occurrence

850:    Notes:
851:     Not for use in Fortran

853:    Level: intermediate

855: @*/
856: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
857: {
858:   const char *stmp = a, *ltmp = NULL;

861:   while (stmp) {
862:     stmp = (char*)strstr(stmp,b);
863:     if (stmp) {ltmp = stmp;stmp++;}
864:   }
865:   *tmp = (char*)ltmp;
866:   return(0);
867: }

869: /*@C
870:    PetscStrstr - Locates first occurrence of string in another string

872:    Not Collective

874:    Input Parameters:
875: +  haystack - string to search
876: -  needle - string to find

878:    Output Parameter:
879: .  tmp - location of occurrence, is a NULL if the string is not found

881:    Notes:
882:     Not for use in Fortran

884:    Level: intermediate

886: @*/
887: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
888: {
890:   *tmp = (char*)strstr(haystack,needle);
891:   return(0);
892: }

894: struct _p_PetscToken {char token;char *array;char *current;};

896: /*@C
897:    PetscTokenFind - Locates next "token" in a string

899:    Not Collective

901:    Input Parameters:
902: .  a - pointer to token

904:    Output Parameter:
905: .  result - location of occurrence, NULL if not found

907:    Notes:

909:      This version is different from the system version in that
910:   it allows you to pass a read-only string into the function.

912:      This version also treats all characters etc. inside a double quote "
913:    as a single token.

915:      For example if the separator character is + and the string is xxxx+y then the first fine will return a pointer to a null terminated xxxx and the
916:    second will return a null terminated y

918:      If the separator character is + and the string is xxxx then the first and only token found will be a pointer to a null terminated xxxx

920:     Not for use in Fortran

922:    Level: intermediate

924: .seealso: PetscTokenCreate(), PetscTokenDestroy()
925: @*/
926: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
927: {
928:   char *ptr = a->current,token;

931:   *result = a->current;
932:   if (ptr && !*ptr) {*result = NULL; return(0);}
933:   token = a->token;
934:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
935:   while (ptr) {
936:     if (*ptr == token) {
937:       *ptr++ = 0;
938:       while (*ptr == a->token) ptr++;
939:       a->current = ptr;
940:       break;
941:     }
942:     if (!*ptr) {
943:       a->current = NULL;
944:       break;
945:     }
946:     ptr++;
947:   }
948:   return(0);
949: }

951: /*@C
952:    PetscTokenCreate - Creates a PetscToken used to find tokens in a string

954:    Not Collective

956:    Input Parameters:
957: +  string - the string to look in
958: -  b - the separator character

960:    Output Parameter:
961: .  t- the token object

963:    Notes:

965:      This version is different from the system version in that
966:   it allows you to pass a read-only string into the function.

968:     Not for use in Fortran

970:    Level: intermediate

972: .seealso: PetscTokenFind(), PetscTokenDestroy()
973: @*/
974: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
975: {

979:   PetscNew(t);
980:   PetscStrallocpy(a,&(*t)->array);

982:   (*t)->current = (*t)->array;
983:   (*t)->token   = b;
984:   return(0);
985: }

987: /*@C
988:    PetscTokenDestroy - Destroys a PetscToken

990:    Not Collective

992:    Input Parameters:
993: .  a - pointer to token

995:    Level: intermediate

997:    Notes:
998:     Not for use in Fortran

1000: .seealso: PetscTokenCreate(), PetscTokenFind()
1001: @*/
1002: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
1003: {

1007:   if (!*a) return(0);
1008:   PetscFree((*a)->array);
1009:   PetscFree(*a);
1010:   return(0);
1011: }

1013: /*@C
1014:    PetscStrInList - search string in character-delimited list

1016:    Not Collective

1018:    Input Parameters:
1019: +  str - the string to look for
1020: .  list - the list to search in
1021: -  sep - the separator character

1023:    Output Parameter:
1024: .  found - whether str is in list

1026:    Level: intermediate

1028:    Notes:
1029:     Not for use in Fortran

1031: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1032: @*/
1033: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1034: {
1035:   PetscToken     token;
1036:   char           *item;

1040:   *found = PETSC_FALSE;
1041:   PetscTokenCreate(list,sep,&token);
1042:   PetscTokenFind(token,&item);
1043:   while (item) {
1044:     PetscStrcmp(str,item,found);
1045:     if (*found) break;
1046:     PetscTokenFind(token,&item);
1047:   }
1048:   PetscTokenDestroy(&token);
1049:   return(0);
1050: }

1052: /*@C
1053:    PetscGetPetscDir - Gets the directory PETSc is installed in

1055:    Not Collective

1057:    Output Parameter:
1058: .  dir - the directory

1060:    Level: developer

1062:    Notes:
1063:     Not for use in Fortran

1065: @*/
1066: PetscErrorCode  PetscGetPetscDir(const char *dir[])
1067: {
1069:   *dir = PETSC_DIR;
1070:   return(0);
1071: }

1073: /*@C
1074:    PetscStrreplace - Replaces substrings in string with other substrings

1076:    Not Collective

1078:    Input Parameters:
1079: +   comm - MPI_Comm of processors that are processing the string
1080: .   aa - the string to look in
1081: .   b - the resulting copy of a with replaced strings (b can be the same as a)
1082: -   len - the length of b

1084:    Notes:
1085:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1086:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1087:       as well as any environmental variables.

1089:       PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1090:       PETSc was built with and do not use environmental variables.

1092:       Not for use in Fortran

1094:    Level: intermediate

1096: @*/
1097: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1098: {
1100:   int            i = 0;
1101:   size_t         l,l1,l2,l3;
1102:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1103:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",NULL};
1104:   char           *r[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};
1105:   PetscBool      flag;
1106:   static size_t  DISPLAY_LENGTH = 265,USER_LENGTH = 256, HOST_LENGTH = 256;

1109:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1110:   if (aa == b) {
1111:     PetscStrallocpy(aa,(char**)&a);
1112:   }
1113:   PetscMalloc1(len,&work);

1115:   /* get values for replaced variables */
1116:   PetscStrallocpy(PETSC_ARCH,&r[0]);
1117:   PetscStrallocpy(PETSC_DIR,&r[1]);
1118:   PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
1119:   PetscMalloc1(DISPLAY_LENGTH,&r[3]);
1120:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1121:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1122:   PetscMalloc1(USER_LENGTH,&r[6]);
1123:   PetscMalloc1(HOST_LENGTH,&r[7]);
1124:   PetscGetDisplay(r[3],DISPLAY_LENGTH);
1125:   PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
1126:   PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
1127:   PetscGetUserName(r[6],USER_LENGTH);
1128:   PetscGetHostName(r[7],HOST_LENGTH);

1130:   /* replace that are in environment */
1131:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,sizeof(env),&flag);
1132:   if (flag) {
1133:     PetscFree(r[2]);
1134:     PetscStrallocpy(env,&r[2]);
1135:   }

1137:   /* replace the requested strings */
1138:   PetscStrncpy(b,a,len);
1139:   while (s[i]) {
1140:     PetscStrlen(s[i],&l);
1141:     PetscStrstr(b,s[i],&par);
1142:     while (par) {
1143:       *par =  0;
1144:       par += l;

1146:       PetscStrlen(b,&l1);
1147:       PetscStrlen(r[i],&l2);
1148:       PetscStrlen(par,&l3);
1149:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1150:       PetscStrncpy(work,b,len);
1151:       PetscStrlcat(work,r[i],len);
1152:       PetscStrlcat(work,par,len);
1153:       PetscStrncpy(b,work,len);
1154:       PetscStrstr(b,s[i],&par);
1155:     }
1156:     i++;
1157:   }
1158:   i = 0;
1159:   while (r[i]) {
1160:     tfree = (char*)r[i];
1161:     PetscFree(tfree);
1162:     i++;
1163:   }

1165:   /* look for any other ${xxx} strings to replace from environmental variables */
1166:   PetscStrstr(b,"${",&par);
1167:   while (par) {
1168:     *par  = 0;
1169:     par  += 2;
1170:     PetscStrncpy(work,b,len);
1171:     PetscStrstr(par,"}",&epar);
1172:     *epar = 0;
1173:     epar += 1;
1174:     PetscOptionsGetenv(comm,par,env,sizeof(env),&flag);
1175:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1176:     PetscStrlcat(work,env,len);
1177:     PetscStrlcat(work,epar,len);
1178:     PetscStrncpy(b,work,len);
1179:     PetscStrstr(b,"${",&par);
1180:   }
1181:   PetscFree(work);
1182:   if (aa == b) {
1183:     PetscFree(a);
1184:   }
1185:   return(0);
1186: }

1188: /*@C
1189:    PetscEListFind - searches list of strings for given string, using case insensitive matching

1191:    Not Collective

1193:    Input Parameters:
1194: +  n - number of strings in
1195: .  list - list of strings to search
1196: -  str - string to look for, empty string "" accepts default (first entry in list)

1198:    Output Parameters:
1199: +  value - index of matching string (if found)
1200: -  found - boolean indicating whether string was found (can be NULL)

1202:    Notes:
1203:    Not for use in Fortran

1205:    Level: advanced
1206: @*/
1207: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1208: {
1210:   PetscBool matched;
1211:   PetscInt i;

1214:   if (found) *found = PETSC_FALSE;
1215:   for (i=0; i<n; i++) {
1216:     PetscStrcasecmp(str,list[i],&matched);
1217:     if (matched || !str[0]) {
1218:       if (found) *found = PETSC_TRUE;
1219:       *value = i;
1220:       break;
1221:     }
1222:   }
1223:   return(0);
1224: }

1226: /*@C
1227:    PetscEnumFind - searches enum list of strings for given string, using case insensitive matching

1229:    Not Collective

1231:    Input Parameters:
1232: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1233: -  str - string to look for

1235:    Output Parameters:
1236: +  value - index of matching string (if found)
1237: -  found - boolean indicating whether string was found (can be NULL)

1239:    Notes:
1240:    Not for use in Fortran

1242:    Level: advanced
1243: @*/
1244: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1245: {
1247:   PetscInt n = 0,evalue;
1248:   PetscBool efound;

1251:   while (enumlist[n++]) if (n > 50) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument appears to be wrong or have more than 50 entries");
1252:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1253:   n -= 3; /* drop enum name, prefix, and null termination */
1254:   PetscEListFind(n,enumlist,str,&evalue,&efound);
1255:   if (efound) *value = (PetscEnum)evalue;
1256:   if (found) *found = efound;
1257:   return(0);
1258: }