Actual source code: str.c

petsc-master 2019-08-19
Report Typos and Errors

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

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

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

 16:    Not Collective

 18:    Input Parameters:
 19: +  s - pointer to string
 20: -  sp - separator charactor

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

 26:    Level: intermediate

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

 31:    Not for use in Fortran

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

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

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

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

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

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

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

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

101:    Not Collective

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

107:    Level: intermediate

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

112:    Not for use in Fortran

114: .seealso: PetscStrToArray()

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

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

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

129:    Not Collective

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

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

137:    Level: intermediate

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

142:    Null string returns a length of zero

144:    Not for use in Fortran

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

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

158:    Not Collective

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

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

166:    Level: intermediate

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

171:       Not for use in Fortran

173: @*/
174: PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
175: {
177:   size_t         len;
178:   char           *tmp = 0;

181:   if (s) {
182:     PetscStrlen(s,&len);
183:     PetscMalloc1(1+len,&tmp);
184:     PetscStrcpy(tmp,s);
185:   }
186:   *t = tmp;
187:   return(0);
188: }

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

193:    Not Collective

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

198:    Output Parameter:
199: .  t - the copied array string

201:    Level: intermediate

203:    Note:
204:       Not for use in Fortran

206: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

208: @*/
209: PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
210: {
212:   PetscInt       i,n = 0;

215:   while (list[n++]) ;
216:   PetscMalloc1(n+1,t);
217:   for (i=0; i<n; i++) {
218:     PetscStrallocpy(list[i],(*t)+i);
219:   }
220:   (*t)[n] = NULL;
221:   return(0);
222: }

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

227:    Not Collective

229:    Output Parameters:
230: .   list - array of strings

232:    Level: intermediate

234:    Notes:
235:     Not for use in Fortran

237: .seealso: PetscStrArrayallocpy()

239: @*/
240: PetscErrorCode PetscStrArrayDestroy(char ***list)
241: {
242:   PetscInt       n = 0;

246:   if (!*list) return(0);
247:   while ((*list)[n]) {
248:     PetscFree((*list)[n]);
249:     n++;
250:   }
251:   PetscFree(*list);
252:   return(0);
253: }

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

258:    Not Collective

260:    Input Parameters:
261: +  n - the number of string entries
262: -  s - pointer to array of strings

264:    Output Parameter:
265: .  t - the copied array string

267:    Level: intermediate

269:    Note:
270:       Not for use in Fortran

272: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

274: @*/
275: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
276: {
278:   PetscInt       i;

281:   PetscMalloc1(n,t);
282:   for (i=0; i<n; i++) {
283:     PetscStrallocpy(list[i],(*t)+i);
284:   }
285:   return(0);
286: }

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

291:    Not Collective

293:    Output Parameters:
294: +   n - number of string entries
295: -   list - array of strings

297:    Level: intermediate

299:    Notes:
300:     Not for use in Fortran

302: .seealso: PetscStrArrayallocpy()

304: @*/
305: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
306: {
308:   PetscInt       i;

311:   if (!*list) return(0);
312:   for (i=0; i<n; i++){
313:     PetscFree((*list)[i]);
314:   }
315:   PetscFree(*list);
316:   return(0);
317: }

319: /*@C
320:    PetscStrcpy - Copies a string

322:    Not Collective

324:    Input Parameters:
325: .  t - pointer to string

327:    Output Parameter:
328: .  s - the copied string

330:    Level: intermediate

332:    Notes:
333:      Null string returns a string starting with zero

335:      Not for use in Fortran

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

339: @*/

341: PetscErrorCode  PetscStrcpy(char s[],const char t[])
342: {
344:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
345:   if (t) strcpy(s,t);
346:   else if (s) s[0] = 0;
347:   return(0);
348: }

350: /*@C
351:    PetscStrncpy - Copies a string up to a certain length

353:    Not Collective

355:    Input Parameters:
356: +  t - pointer to string
357: -  n - the length to copy

359:    Output Parameter:
360: .  s - the copied string

362:    Level: intermediate

364:    Note:
365:      Null string returns a string starting with zero

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

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

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

375: @*/
376: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
377: {
379:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
380:   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");
381:   if (t) {
382:     if (n > 1) {
383:       strncpy(s,t,n-1);
384:       s[n-1] = '\0';
385:     } else {
386:       s[0] = '\0';
387:     }
388:   } else if (s) s[0] = 0;
389:   return(0);
390: }

392: /*@C
393:    PetscStrcat - Concatenates a string onto a given string

395:    Not Collective

397:    Input Parameters:
398: +  s - string to be added to
399: -  t - pointer to string to be added to end

401:    Level: intermediate

403:    Notes:
404:     Not for use in Fortran

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

408: @*/
409: PetscErrorCode  PetscStrcat(char s[],const char t[])
410: {
412:   if (!t) return(0);
413:   strcat(s,t);
414:   return(0);
415: }

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

420:    Not Collective

422:    Input Parameters:
423: +  s - pointer to string to be added to at end
424: .  t - string to be added to
425: -  n - length of the original allocated string

427:    Level: intermediate

429:   Notes:
430:   Not for use in Fortran

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

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

438: @*/
439: PetscErrorCode  PetscStrlcat(char s[],const char t[],size_t n)
440: {
441:   size_t         len;

445:   if (t && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
446:   if (!t) return(0);
447:   PetscStrlen(t,&len);
448:   strncat(s,t,n - len);
449:   s[n-1] = 0;
450:   return(0);
451: }

453: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
454: {
455:   int c;

457:   if (!a && !b)      *flg = PETSC_TRUE;
458:   else if (!a || !b) *flg = PETSC_FALSE;
459:   else {
460:     c = strcmp(a,b);
461:     if (c) *flg = PETSC_FALSE;
462:     else   *flg = PETSC_TRUE;
463:   }
464: }

466: /*@C
467:    PetscStrcmp - Compares two strings,

469:    Not Collective

471:    Input Parameters:
472: +  a - pointer to string first string
473: -  b - pointer to second string

475:    Output Parameter:
476: .  flg - PETSC_TRUE if the two strings are equal

478:    Level: intermediate

480:    Notes:
481:     Not for use in Fortran

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

485: @*/
486: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
487: {
488:   int c;

491:   if (!a && !b)      *flg = PETSC_TRUE;
492:   else if (!a || !b) *flg = PETSC_FALSE;
493:   else {
494:     c = strcmp(a,b);
495:     if (c) *flg = PETSC_FALSE;
496:     else   *flg = PETSC_TRUE;
497:   }
498:   return(0);
499: }

501: /*@C
502:    PetscStrgrt - If first string is greater than the second

504:    Not Collective

506:    Input Parameters:
507: +  a - pointer to first string
508: -  b - pointer to second string

510:    Output Parameter:
511: .  flg - if the first string is greater

513:    Notes:
514:     Null arguments are ok, a null string is considered smaller than
515:     all others

517:    Not for use in Fortran

519:    Level: intermediate

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

523: @*/
524: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
525: {
526:   int c;

529:   if (!a && !b) *t = PETSC_FALSE;
530:   else if (a && !b) *t = PETSC_TRUE;
531:   else if (!a && b) *t = PETSC_FALSE;
532:   else {
533:     c = strcmp(a,b);
534:     if (c > 0) *t = PETSC_TRUE;
535:     else       *t = PETSC_FALSE;
536:   }
537:   return(0);
538: }

540: /*@C
541:    PetscStrcasecmp - Returns true if the two strings are the same
542:      except possibly for case.

544:    Not Collective

546:    Input Parameters:
547: +  a - pointer to first string
548: -  b - pointer to second string

550:    Output Parameter:
551: .  flg - if the two strings are the same

553:    Notes:
554:     Null arguments are ok

556:    Not for use in Fortran

558:    Level: intermediate

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

562: @*/
563: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
564: {
565:   int c;

568:   if (!a && !b) c = 0;
569:   else if (!a || !b) c = 1;
570: #if defined(PETSC_HAVE_STRCASECMP)
571:   else c = strcasecmp(a,b);
572: #elif defined(PETSC_HAVE_STRICMP)
573:   else c = stricmp(a,b);
574: #else
575:   else {
576:     char           *aa,*bb;
578:     PetscStrallocpy(a,&aa);
579:     PetscStrallocpy(b,&bb);
580:     PetscStrtolower(aa);
581:     PetscStrtolower(bb);
582:     PetscStrcmp(aa,bb,t);
583:     PetscFree(aa);
584:     PetscFree(bb);
585:     return(0);
586:   }
587: #endif
588:   if (!c) *t = PETSC_TRUE;
589:   else    *t = PETSC_FALSE;
590:   return(0);
591: }



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

598:    Not Collective

600:    Input Parameters:
601: +  a - pointer to first string
602: .  b - pointer to second string
603: -  n - length to compare up to

605:    Output Parameter:
606: .  t - if the two strings are equal

608:    Level: intermediate

610:    Notes:
611:     Not for use in Fortran

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

615: @*/
616: PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
617: {
618:   int c;

621:   c = strncmp(a,b,n);
622:   if (!c) *t = PETSC_TRUE;
623:   else    *t = PETSC_FALSE;
624:   return(0);
625: }

627: /*@C
628:    PetscStrchr - Locates first occurance of a character in a string

630:    Not Collective

632:    Input Parameters:
633: +  a - pointer to string
634: -  b - character

636:    Output Parameter:
637: .  c - location of occurance, NULL if not found

639:    Level: intermediate

641:    Notes:
642:     Not for use in Fortran

644: @*/
645: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
646: {
648:   *c = (char*)strchr(a,b);
649:   return(0);
650: }

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

656:    Not Collective

658:    Input Parameters:
659: +  a - pointer to string
660: -  b - character

662:    Output Parameter:
663: .  tmp - location of occurance, a if not found

665:    Level: intermediate

667:    Notes:
668:     Not for use in Fortran

670: @*/
671: PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
672: {
674:   *tmp = (char*)strrchr(a,b);
675:   if (!*tmp) *tmp = (char*)a;
676:   else *tmp = *tmp + 1;
677:   return(0);
678: }

680: /*@C
681:    PetscStrtolower - Converts string to lower case

683:    Not Collective

685:    Input Parameters:
686: .  a - pointer to string

688:    Level: intermediate

690:    Notes:
691:     Not for use in Fortran

693: @*/
694: PetscErrorCode  PetscStrtolower(char a[])
695: {
697:   while (*a) {
698:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
699:     a++;
700:   }
701:   return(0);
702: }

704: /*@C
705:    PetscStrtoupper - Converts string to upper case

707:    Not Collective

709:    Input Parameters:
710: .  a - pointer to string

712:    Level: intermediate

714:    Notes:
715:     Not for use in Fortran

717: @*/
718: PetscErrorCode  PetscStrtoupper(char a[])
719: {
721:   while (*a) {
722:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
723:     a++;
724:   }
725:   return(0);
726: }

728: /*@C
729:    PetscStrendswith - Determines if a string ends with a certain string

731:    Not Collective

733:    Input Parameters:
734: +  a - pointer to string
735: -  b - string to endwith

737:    Output Parameter:
738: .  flg - PETSC_TRUE or PETSC_FALSE

740:    Notes:
741:     Not for use in Fortran

743:    Level: intermediate

745: @*/
746: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
747: {
748:   char           *test;
750:   size_t         na,nb;

753:   *flg = PETSC_FALSE;
754:   PetscStrrstr(a,b,&test);
755:   if (test) {
756:     PetscStrlen(a,&na);
757:     PetscStrlen(b,&nb);
758:     if (a+na-nb == test) *flg = PETSC_TRUE;
759:   }
760:   return(0);
761: }

763: /*@C
764:    PetscStrbeginswith - Determines if a string begins with a certain string

766:    Not Collective

768:    Input Parameters:
769: +  a - pointer to string
770: -  b - string to begin with

772:    Output Parameter:
773: .  flg - PETSC_TRUE or PETSC_FALSE

775:    Notes:
776:     Not for use in Fortran

778:    Level: intermediate

780: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
781:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()

783: @*/
784: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
785: {
786:   char           *test;

790:   *flg = PETSC_FALSE;
791:   PetscStrrstr(a,b,&test);
792:   if (test && (test == a)) *flg = PETSC_TRUE;
793:   return(0);
794: }


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

800:    Not Collective

802:    Input Parameters:
803: +  a - pointer to string
804: -  bs - strings to endwith (last entry must be null)

806:    Output Parameter:
807: .  cnt - the index of the string it ends with or 1+the last possible index

809:    Notes:
810:     Not for use in Fortran

812:    Level: intermediate

814: @*/
815: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
816: {
817:   PetscBool      flg;

821:   *cnt = 0;
822:   while (bs[*cnt]) {
823:     PetscStrendswith(a,bs[*cnt],&flg);
824:     if (flg) return(0);
825:     *cnt += 1;
826:   }
827:   return(0);
828: }

830: /*@C
831:    PetscStrrstr - Locates last occurance of string in another string

833:    Not Collective

835:    Input Parameters:
836: +  a - pointer to string
837: -  b - string to find

839:    Output Parameter:
840: .  tmp - location of occurance

842:    Notes:
843:     Not for use in Fortran

845:    Level: intermediate

847: @*/
848: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
849: {
850:   const char *stmp = a, *ltmp = 0;

853:   while (stmp) {
854:     stmp = (char*)strstr(stmp,b);
855:     if (stmp) {ltmp = stmp;stmp++;}
856:   }
857:   *tmp = (char*)ltmp;
858:   return(0);
859: }

861: /*@C
862:    PetscStrstr - Locates first occurance of string in another string

864:    Not Collective

866:    Input Parameters:
867: +  haystack - string to search
868: -  needle - string to find

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

873:    Notes:
874:     Not for use in Fortran

876:    Level: intermediate

878: @*/
879: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
880: {
882:   *tmp = (char*)strstr(haystack,needle);
883:   return(0);
884: }

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

888: /*@C
889:    PetscTokenFind - Locates next "token" in a string

891:    Not Collective

893:    Input Parameters:
894: .  a - pointer to token

896:    Output Parameter:
897: .  result - location of occurance, NULL if not found

899:    Notes:

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

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

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

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

912:     Not for use in Fortran

914:    Level: intermediate


917: .seealso: PetscTokenCreate(), PetscTokenDestroy()
918: @*/
919: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
920: {
921:   char *ptr = a->current,token;

924:   *result = a->current;
925:   if (ptr && !*ptr) {*result = 0;return(0);}
926:   token = a->token;
927:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
928:   while (ptr) {
929:     if (*ptr == token) {
930:       *ptr++ = 0;
931:       while (*ptr == a->token) ptr++;
932:       a->current = ptr;
933:       break;
934:     }
935:     if (!*ptr) {
936:       a->current = 0;
937:       break;
938:     }
939:     ptr++;
940:   }
941:   return(0);
942: }

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

947:    Not Collective

949:    Input Parameters:
950: +  string - the string to look in
951: -  b - the separator character

953:    Output Parameter:
954: .  t- the token object

956:    Notes:

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

961:     Not for use in Fortran

963:    Level: intermediate

965: .seealso: PetscTokenFind(), PetscTokenDestroy()
966: @*/
967: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
968: {

972:   PetscNew(t);
973:   PetscStrallocpy(a,&(*t)->array);

975:   (*t)->current = (*t)->array;
976:   (*t)->token   = b;
977:   return(0);
978: }

980: /*@C
981:    PetscTokenDestroy - Destroys a PetscToken

983:    Not Collective

985:    Input Parameters:
986: .  a - pointer to token

988:    Level: intermediate

990:    Notes:
991:     Not for use in Fortran

993: .seealso: PetscTokenCreate(), PetscTokenFind()
994: @*/
995: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
996: {

1000:   if (!*a) return(0);
1001:   PetscFree((*a)->array);
1002:   PetscFree(*a);
1003:   return(0);
1004: }

1006: /*@C
1007:    PetscStrInList - search string in character-delimited list

1009:    Not Collective

1011:    Input Parameters:
1012: +  str - the string to look for
1013: .  list - the list to search in
1014: -  sep - the separator character

1016:    Output Parameter:
1017: .  found - whether str is in list

1019:    Level: intermediate

1021:    Notes:
1022:     Not for use in Fortran

1024: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1025: @*/
1026: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1027: {
1028:   PetscToken     token;
1029:   char           *item;

1033:   *found = PETSC_FALSE;
1034:   PetscTokenCreate(list,sep,&token);
1035:   PetscTokenFind(token,&item);
1036:   while (item) {
1037:     PetscStrcmp(str,item,found);
1038:     if (*found) break;
1039:     PetscTokenFind(token,&item);
1040:   }
1041:   PetscTokenDestroy(&token);
1042:   return(0);
1043: }

1045: /*@C
1046:    PetscGetPetscDir - Gets the directory PETSc is installed in

1048:    Not Collective

1050:    Output Parameter:
1051: .  dir - the directory

1053:    Level: developer

1055:    Notes:
1056:     Not for use in Fortran

1058: @*/
1059: PetscErrorCode  PetscGetPetscDir(const char *dir[])
1060: {
1062:   *dir = PETSC_DIR;
1063:   return(0);
1064: }

1066: /*@C
1067:    PetscStrreplace - Replaces substrings in string with other substrings

1069:    Not Collective

1071:    Input Parameters:
1072: +   comm - MPI_Comm of processors that are processing the string
1073: .   aa - the string to look in
1074: .   b - the resulting copy of a with replaced strings (b can be the same as a)
1075: -   len - the length of b

1077:    Notes:
1078:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1079:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1080:       as well as any environmental variables.

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

1085:       Not for use in Fortran

1087:    Level: intermediate

1089: @*/
1090: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1091: {
1093:   int            i = 0;
1094:   size_t         l,l1,l2,l3;
1095:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1096:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1097:   char           *r[] = {0,0,0,0,0,0,0,0,0};
1098:   PetscBool      flag;

1101:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1102:   if (aa == b) {
1103:     PetscStrallocpy(aa,(char**)&a);
1104:   }
1105:   PetscMalloc1(len,&work);

1107:   /* get values for replaced variables */
1108:   PetscStrallocpy(PETSC_ARCH,&r[0]);
1109:   PetscStrallocpy(PETSC_DIR,&r[1]);
1110:   PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
1111:   PetscMalloc1(256,&r[3]);
1112:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1113:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1114:   PetscMalloc1(256,&r[6]);
1115:   PetscMalloc1(256,&r[7]);
1116:   PetscGetDisplay(r[3],256);
1117:   PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
1118:   PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
1119:   PetscGetUserName(r[6],256);
1120:   PetscGetHostName(r[7],256);

1122:   /* replace that are in environment */
1123:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1124:   if (flag) {
1125:     PetscFree(r[2]);
1126:     PetscStrallocpy(env,&r[2]);
1127:   }

1129:   /* replace the requested strings */
1130:   PetscStrncpy(b,a,len);
1131:   while (s[i]) {
1132:     PetscStrlen(s[i],&l);
1133:     PetscStrstr(b,s[i],&par);
1134:     while (par) {
1135:       *par =  0;
1136:       par += l;

1138:       PetscStrlen(b,&l1);
1139:       PetscStrlen(r[i],&l2);
1140:       PetscStrlen(par,&l3);
1141:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1142:       PetscStrcpy(work,b);
1143:       PetscStrcat(work,r[i]);
1144:       PetscStrcat(work,par);
1145:       PetscStrncpy(b,work,len);
1146:       PetscStrstr(b,s[i],&par);
1147:     }
1148:     i++;
1149:   }
1150:   i = 0;
1151:   while (r[i]) {
1152:     tfree = (char*)r[i];
1153:     PetscFree(tfree);
1154:     i++;
1155:   }

1157:   /* look for any other ${xxx} strings to replace from environmental variables */
1158:   PetscStrstr(b,"${",&par);
1159:   while (par) {
1160:     *par  = 0;
1161:     par  += 2;
1162:     PetscStrcpy(work,b);
1163:     PetscStrstr(par,"}",&epar);
1164:     *epar = 0;
1165:     epar += 1;
1166:     PetscOptionsGetenv(comm,par,env,256,&flag);
1167:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1168:     PetscStrcat(work,env);
1169:     PetscStrcat(work,epar);
1170:     PetscStrcpy(b,work);
1171:     PetscStrstr(b,"${",&par);
1172:   }
1173:   PetscFree(work);
1174:   if (aa == b) {
1175:     PetscFree(a);
1176:   }
1177:   return(0);
1178: }

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

1183:    Not Collective

1185:    Input Parameters:
1186: +  n - number of strings in
1187: .  list - list of strings to search
1188: -  str - string to look for, empty string "" accepts default (first entry in list)

1190:    Output Parameters:
1191: +  value - index of matching string (if found)
1192: -  found - boolean indicating whether string was found (can be NULL)

1194:    Notes:
1195:    Not for use in Fortran

1197:    Level: advanced
1198: @*/
1199: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1200: {
1202:   PetscBool matched;
1203:   PetscInt i;

1206:   if (found) *found = PETSC_FALSE;
1207:   for (i=0; i<n; i++) {
1208:     PetscStrcasecmp(str,list[i],&matched);
1209:     if (matched || !str[0]) {
1210:       if (found) *found = PETSC_TRUE;
1211:       *value = i;
1212:       break;
1213:     }
1214:   }
1215:   return(0);
1216: }

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

1221:    Not Collective

1223:    Input Parameters:
1224: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1225: -  str - string to look for

1227:    Output Parameters:
1228: +  value - index of matching string (if found)
1229: -  found - boolean indicating whether string was found (can be NULL)

1231:    Notes:
1232:    Not for use in Fortran

1234:    Level: advanced
1235: @*/
1236: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1237: {
1239:   PetscInt n = 0,evalue;
1240:   PetscBool efound;

1243:   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");
1244:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1245:   n -= 3; /* drop enum name, prefix, and null termination */
1246:   PetscEListFind(n,enumlist,str,&evalue,&efound);
1247:   if (efound) *value = (PetscEnum)evalue;
1248:   if (found) *found = efound;
1249:   return(0);
1250: }