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 Parameter:
 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: }



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

609:    Not Collective

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

616:    Output Parameter:
617: .  t - if the two strings are equal

619:    Level: intermediate

621:    Notes:
622:     Not for use in Fortran

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

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

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

638: /*@C
639:    PetscStrchr - Locates first occurance of a character in a string

641:    Not Collective

643:    Input Parameters:
644: +  a - pointer to string
645: -  b - character

647:    Output Parameter:
648: .  c - location of occurance, NULL if not found

650:    Level: intermediate

652:    Notes:
653:     Not for use in Fortran

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

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

667:    Not Collective

669:    Input Parameters:
670: +  a - pointer to string
671: -  b - character

673:    Output Parameter:
674: .  tmp - location of occurance, a if not found

676:    Level: intermediate

678:    Notes:
679:     Not for use in Fortran

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

691: /*@C
692:    PetscStrtolower - Converts string to lower case

694:    Not Collective

696:    Input Parameters:
697: .  a - pointer to string

699:    Level: intermediate

701:    Notes:
702:     Not for use in Fortran

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

715: /*@C
716:    PetscStrtoupper - Converts string to upper case

718:    Not Collective

720:    Input Parameters:
721: .  a - pointer to string

723:    Level: intermediate

725:    Notes:
726:     Not for use in Fortran

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

739: /*@C
740:    PetscStrendswith - Determines if a string ends with a certain string

742:    Not Collective

744:    Input Parameters:
745: +  a - pointer to string
746: -  b - string to endwith

748:    Output Parameter:
749: .  flg - PETSC_TRUE or PETSC_FALSE

751:    Notes:
752:     Not for use in Fortran

754:    Level: intermediate

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

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

774: /*@C
775:    PetscStrbeginswith - Determines if a string begins with a certain string

777:    Not Collective

779:    Input Parameters:
780: +  a - pointer to string
781: -  b - string to begin with

783:    Output Parameter:
784: .  flg - PETSC_TRUE or PETSC_FALSE

786:    Notes:
787:     Not for use in Fortran

789:    Level: intermediate

791: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
792:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()

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

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


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

811:    Not Collective

813:    Input Parameters:
814: +  a - pointer to string
815: -  bs - strings to end with (last entry must be NULL)

817:    Output Parameter:
818: .  cnt - the index of the string it ends with or the index of NULL

820:    Notes:
821:     Not for use in Fortran

823:    Level: intermediate

825: @*/
826: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
827: {
828:   PetscBool      flg;

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

841: /*@C
842:    PetscStrrstr - Locates last occurance of string in another string

844:    Not Collective

846:    Input Parameters:
847: +  a - pointer to string
848: -  b - string to find

850:    Output Parameter:
851: .  tmp - location of occurance

853:    Notes:
854:     Not for use in Fortran

856:    Level: intermediate

858: @*/
859: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
860: {
861:   const char *stmp = a, *ltmp = NULL;

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

872: /*@C
873:    PetscStrstr - Locates first occurance of string in another string

875:    Not Collective

877:    Input Parameters:
878: +  haystack - string to search
879: -  needle - string to find

881:    Output Parameter:
882: .  tmp - location of occurance, is a NULL if the string is not found

884:    Notes:
885:     Not for use in Fortran

887:    Level: intermediate

889: @*/
890: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
891: {
893:   *tmp = (char*)strstr(haystack,needle);
894:   return(0);
895: }

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

899: /*@C
900:    PetscTokenFind - Locates next "token" in a string

902:    Not Collective

904:    Input Parameters:
905: .  a - pointer to token

907:    Output Parameter:
908: .  result - location of occurance, NULL if not found

910:    Notes:

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

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

918:      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
919:    second will return a null terminated y

921:      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

923:     Not for use in Fortran

925:    Level: intermediate


928: .seealso: PetscTokenCreate(), PetscTokenDestroy()
929: @*/
930: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
931: {
932:   char *ptr = a->current,token;

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

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

958:    Not Collective

960:    Input Parameters:
961: +  string - the string to look in
962: -  b - the separator character

964:    Output Parameter:
965: .  t- the token object

967:    Notes:

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

972:     Not for use in Fortran

974:    Level: intermediate

976: .seealso: PetscTokenFind(), PetscTokenDestroy()
977: @*/
978: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
979: {

983:   PetscNew(t);
984:   PetscStrallocpy(a,&(*t)->array);

986:   (*t)->current = (*t)->array;
987:   (*t)->token   = b;
988:   return(0);
989: }

991: /*@C
992:    PetscTokenDestroy - Destroys a PetscToken

994:    Not Collective

996:    Input Parameters:
997: .  a - pointer to token

999:    Level: intermediate

1001:    Notes:
1002:     Not for use in Fortran

1004: .seealso: PetscTokenCreate(), PetscTokenFind()
1005: @*/
1006: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
1007: {

1011:   if (!*a) return(0);
1012:   PetscFree((*a)->array);
1013:   PetscFree(*a);
1014:   return(0);
1015: }

1017: /*@C
1018:    PetscStrInList - search string in character-delimited list

1020:    Not Collective

1022:    Input Parameters:
1023: +  str - the string to look for
1024: .  list - the list to search in
1025: -  sep - the separator character

1027:    Output Parameter:
1028: .  found - whether str is in list

1030:    Level: intermediate

1032:    Notes:
1033:     Not for use in Fortran

1035: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1036: @*/
1037: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1038: {
1039:   PetscToken     token;
1040:   char           *item;

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

1056: /*@C
1057:    PetscGetPetscDir - Gets the directory PETSc is installed in

1059:    Not Collective

1061:    Output Parameter:
1062: .  dir - the directory

1064:    Level: developer

1066:    Notes:
1067:     Not for use in Fortran

1069: @*/
1070: PetscErrorCode  PetscGetPetscDir(const char *dir[])
1071: {
1073:   *dir = PETSC_DIR;
1074:   return(0);
1075: }

1077: /*@C
1078:    PetscStrreplace - Replaces substrings in string with other substrings

1080:    Not Collective

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

1088:    Notes:
1089:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1090:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1091:       as well as any environmental variables.

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

1096:       Not for use in Fortran

1098:    Level: intermediate

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

1113:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1114:   if (aa == b) {
1115:     PetscStrallocpy(aa,(char**)&a);
1116:   }
1117:   PetscMalloc1(len,&work);

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

1134:   /* replace that are in environment */
1135:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,sizeof(env),&flag);
1136:   if (flag) {
1137:     PetscFree(r[2]);
1138:     PetscStrallocpy(env,&r[2]);
1139:   }

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

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

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

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

1195:    Not Collective

1197:    Input Parameters:
1198: +  n - number of strings in
1199: .  list - list of strings to search
1200: -  str - string to look for, empty string "" accepts default (first entry in list)

1202:    Output Parameters:
1203: +  value - index of matching string (if found)
1204: -  found - boolean indicating whether string was found (can be NULL)

1206:    Notes:
1207:    Not for use in Fortran

1209:    Level: advanced
1210: @*/
1211: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1212: {
1214:   PetscBool matched;
1215:   PetscInt i;

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

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

1233:    Not Collective

1235:    Input Parameters:
1236: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1237: -  str - string to look for

1239:    Output Parameters:
1240: +  value - index of matching string (if found)
1241: -  found - boolean indicating whether string was found (can be NULL)

1243:    Notes:
1244:    Not for use in Fortran

1246:    Level: advanced
1247: @*/
1248: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1249: {
1251:   PetscInt n = 0,evalue;
1252:   PetscBool efound;

1255:   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");
1256:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1257:   n -= 3; /* drop enum name, prefix, and null termination */
1258:   PetscEListFind(n,enumlist,str,&evalue,&efound);
1259:   if (efound) *value = (PetscEnum)evalue;
1260:   if (found) *found = efound;
1261:   return(0);
1262: }