Actual source code: str.c

petsc-master 2019-06-15
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_STRING_H)
 10: #include <string.h>             /* strstr */
 11: #endif
 12: #if defined(PETSC_HAVE_STRINGS_H)
 13: #  include <strings.h>          /* strcasecmp */
 14: #endif

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

 19:    Not Collective

 21:    Input Parameters:
 22: +  s - pointer to string
 23: -  sp - separator charactor

 25:    Output Parameter:
 26: +   argc - the number of entries in the array
 27: -   args - an array of the entries with a null at the end

 29:    Level: intermediate

 31:    Notes:
 32:     this may be called before PetscInitialize() or after PetscFinalize()

 34:    Not for use in Fortran

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

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

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

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

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

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

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

101: /*@C
102:    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().

104:    Not Collective

106:    Output Parameters:
107: +  argc - the number of arguments
108: -  args - the array of arguments

110:    Level: intermediate

112:    Notes:
113:     This may be called before PetscInitialize() or after PetscFinalize()

115:    Not for use in Fortran

117: .seealso: PetscStrToArray()

119: @*/
120: PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
121: {
122:   PetscInt i;

124:   for (i=0; i<argc; i++) free(args[i]);
125:   if (args) free(args);
126:   return 0;
127: }

129: /*@C
130:    PetscStrlen - Gets length of a string

132:    Not Collective

134:    Input Parameters:
135: .  s - pointer to string

137:    Output Parameter:
138: .  len - length in bytes

140:    Level: intermediate

142:    Note:
143:    This routine is analogous to strlen().

145:    Null string returns a length of zero

147:    Not for use in Fortran

149: @*/
150: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
151: {
153:   if (!s) *len = 0;
154:   else    *len = strlen(s);
155:   return(0);
156: }

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

161:    Not Collective

163:    Input Parameters:
164: .  s - pointer to string

166:    Output Parameter:
167: .  t - the copied string

169:    Level: intermediate

171:    Note:
172:       Null string returns a new null string

174:       Not for use in Fortran

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

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

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

196:    Not Collective

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

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

204:    Level: intermediate

206:    Note:
207:       Not for use in Fortran

209: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

211: @*/
212: PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
213: {
215:   PetscInt       i,n = 0;

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

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

230:    Not Collective

232:    Output Parameters:
233: .   list - array of strings

235:    Level: intermediate

237:    Notes:
238:     Not for use in Fortran

240: .seealso: PetscStrArrayallocpy()

242: @*/
243: PetscErrorCode PetscStrArrayDestroy(char ***list)
244: {
245:   PetscInt       n = 0;

249:   if (!*list) return(0);
250:   while ((*list)[n]) {
251:     PetscFree((*list)[n]);
252:     n++;
253:   }
254:   PetscFree(*list);
255:   return(0);
256: }

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

261:    Not Collective

263:    Input Parameters:
264: +  n - the number of string entries
265: -  s - pointer to array of strings

267:    Output Parameter:
268: .  t - the copied array string

270:    Level: intermediate

272:    Note:
273:       Not for use in Fortran

275: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

277: @*/
278: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
279: {
281:   PetscInt       i;

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

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

294:    Not Collective

296:    Output Parameters:
297: +   n - number of string entries
298: -   list - array of strings

300:    Level: intermediate

302:    Notes:
303:     Not for use in Fortran

305: .seealso: PetscStrArrayallocpy()

307: @*/
308: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
309: {
311:   PetscInt       i;

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

322: /*@C
323:    PetscStrcpy - Copies a string

325:    Not Collective

327:    Input Parameters:
328: .  t - pointer to string

330:    Output Parameter:
331: .  s - the copied string

333:    Level: intermediate

335:    Notes:
336:      Null string returns a string starting with zero

338:      Not for use in Fortran

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

342: @*/

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

353: /*@C
354:    PetscStrncpy - Copies a string up to a certain length

356:    Not Collective

358:    Input Parameters:
359: +  t - pointer to string
360: -  n - the length to copy

362:    Output Parameter:
363: .  s - the copied string

365:    Level: intermediate

367:    Note:
368:      Null string returns a string starting with zero

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

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

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

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

395: /*@C
396:    PetscStrcat - Concatenates a string onto a given string

398:    Not Collective

400:    Input Parameters:
401: +  s - string to be added to
402: -  t - pointer to string to be added to end

404:    Level: intermediate

406:    Notes:
407:     Not for use in Fortran

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

411: @*/
412: PetscErrorCode  PetscStrcat(char s[],const char t[])
413: {
415:   if (!t) return(0);
416:   strcat(s,t);
417:   return(0);
418: }

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

423:    Not Collective

425:    Input Parameters:
426: +  s - pointer to string to be added to at end
427: .  t - string to be added to
428: -  n - length of the original allocated string

430:    Level: intermediate

432:   Notes:
433:   Not for use in Fortran

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

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

441: @*/
442: PetscErrorCode  PetscStrlcat(char s[],const char t[],size_t n)
443: {
444:   size_t         len;

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

456: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
457: {
458:   int c;

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

469: /*@C
470:    PetscStrcmp - Compares two strings,

472:    Not Collective

474:    Input Parameters:
475: +  a - pointer to string first string
476: -  b - pointer to second string

478:    Output Parameter:
479: .  flg - PETSC_TRUE if the two strings are equal

481:    Level: intermediate

483:    Notes:
484:     Not for use in Fortran

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

488: @*/
489: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
490: {
491:   int c;

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

504: /*@C
505:    PetscStrgrt - If first string is greater than the second

507:    Not Collective

509:    Input Parameters:
510: +  a - pointer to first string
511: -  b - pointer to second string

513:    Output Parameter:
514: .  flg - if the first string is greater

516:    Notes:
517:     Null arguments are ok, a null string is considered smaller than
518:     all others

520:    Not for use in Fortran

522:    Level: intermediate

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

526: @*/
527: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
528: {
529:   int c;

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

543: /*@C
544:    PetscStrcasecmp - Returns true if the two strings are the same
545:      except possibly for case.

547:    Not Collective

549:    Input Parameters:
550: +  a - pointer to first string
551: -  b - pointer to second string

553:    Output Parameter:
554: .  flg - if the two strings are the same

556:    Notes:
557:     Null arguments are ok

559:    Not for use in Fortran

561:    Level: intermediate

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

565: @*/
566: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
567: {
568:   int c;

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



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

601:    Not Collective

603:    Input Parameters:
604: +  a - pointer to first string
605: .  b - pointer to second string
606: -  n - length to compare up to

608:    Output Parameter:
609: .  t - if the two strings are equal

611:    Level: intermediate

613:    Notes:
614:     Not for use in Fortran

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

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

624:   c = strncmp(a,b,n);
625:   if (!c) *t = PETSC_TRUE;
626:   else    *t = PETSC_FALSE;
627:   return(0);
628: }

630: /*@C
631:    PetscStrchr - Locates first occurance of a character in a string

633:    Not Collective

635:    Input Parameters:
636: +  a - pointer to string
637: -  b - character

639:    Output Parameter:
640: .  c - location of occurance, NULL if not found

642:    Level: intermediate

644:    Notes:
645:     Not for use in Fortran

647: @*/
648: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
649: {
651:   *c = (char*)strchr(a,b);
652:   return(0);
653: }

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

659:    Not Collective

661:    Input Parameters:
662: +  a - pointer to string
663: -  b - character

665:    Output Parameter:
666: .  tmp - location of occurance, a if not found

668:    Level: intermediate

670:    Notes:
671:     Not for use in Fortran

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

683: /*@C
684:    PetscStrtolower - Converts string to lower case

686:    Not Collective

688:    Input Parameters:
689: .  a - pointer to string

691:    Level: intermediate

693:    Notes:
694:     Not for use in Fortran

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

707: /*@C
708:    PetscStrtoupper - Converts string to upper case

710:    Not Collective

712:    Input Parameters:
713: .  a - pointer to string

715:    Level: intermediate

717:    Notes:
718:     Not for use in Fortran

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

731: /*@C
732:    PetscStrendswith - Determines if a string ends with a certain string

734:    Not Collective

736:    Input Parameters:
737: +  a - pointer to string
738: -  b - string to endwith

740:    Output Parameter:
741: .  flg - PETSC_TRUE or PETSC_FALSE

743:    Notes:
744:     Not for use in Fortran

746:    Level: intermediate

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

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

766: /*@C
767:    PetscStrbeginswith - Determines if a string begins with a certain string

769:    Not Collective

771:    Input Parameters:
772: +  a - pointer to string
773: -  b - string to begin with

775:    Output Parameter:
776: .  flg - PETSC_TRUE or PETSC_FALSE

778:    Notes:
779:     Not for use in Fortran

781:    Level: intermediate

783: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
784:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()

786: @*/
787: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
788: {
789:   char           *test;

793:   *flg = PETSC_FALSE;
794:   PetscStrrstr(a,b,&test);
795:   if (test && (test == a)) *flg = PETSC_TRUE;
796:   return(0);
797: }


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

803:    Not Collective

805:    Input Parameters:
806: +  a - pointer to string
807: -  bs - strings to endwith (last entry must be null)

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

812:    Notes:
813:     Not for use in Fortran

815:    Level: intermediate

817: @*/
818: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
819: {
820:   PetscBool      flg;

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

833: /*@C
834:    PetscStrrstr - Locates last occurance of string in another string

836:    Not Collective

838:    Input Parameters:
839: +  a - pointer to string
840: -  b - string to find

842:    Output Parameter:
843: .  tmp - location of occurance

845:    Notes:
846:     Not for use in Fortran

848:    Level: intermediate

850: @*/
851: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
852: {
853:   const char *stmp = a, *ltmp = 0;

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

864: /*@C
865:    PetscStrstr - Locates first occurance of string in another string

867:    Not Collective

869:    Input Parameters:
870: +  haystack - string to search
871: -  needle - string to find

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

876:    Notes:
877:     Not for use in Fortran

879:    Level: intermediate

881: @*/
882: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
883: {
885:   *tmp = (char*)strstr(haystack,needle);
886:   return(0);
887: }

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

891: /*@C
892:    PetscTokenFind - Locates next "token" in a string

894:    Not Collective

896:    Input Parameters:
897: .  a - pointer to token

899:    Output Parameter:
900: .  result - location of occurance, NULL if not found

902:    Notes:

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

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

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

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

915:     Not for use in Fortran

917:    Level: intermediate


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

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

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

950:    Not Collective

952:    Input Parameters:
953: +  string - the string to look in
954: -  b - the separator character

956:    Output Parameter:
957: .  t- the token object

959:    Notes:

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

964:     Not for use in Fortran

966:    Level: intermediate

968: .seealso: PetscTokenFind(), PetscTokenDestroy()
969: @*/
970: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
971: {

975:   PetscNew(t);
976:   PetscStrallocpy(a,&(*t)->array);

978:   (*t)->current = (*t)->array;
979:   (*t)->token   = b;
980:   return(0);
981: }

983: /*@C
984:    PetscTokenDestroy - Destroys a PetscToken

986:    Not Collective

988:    Input Parameters:
989: .  a - pointer to token

991:    Level: intermediate

993:    Notes:
994:     Not for use in Fortran

996: .seealso: PetscTokenCreate(), PetscTokenFind()
997: @*/
998: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
999: {

1003:   if (!*a) return(0);
1004:   PetscFree((*a)->array);
1005:   PetscFree(*a);
1006:   return(0);
1007: }

1009: /*@C
1010:    PetscStrInList - search string in character-delimited list

1012:    Not Collective

1014:    Input Parameters:
1015: +  str - the string to look for
1016: .  list - the list to search in
1017: -  sep - the separator character

1019:    Output Parameter:
1020: .  found - whether str is in list

1022:    Level: intermediate

1024:    Notes:
1025:     Not for use in Fortran

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

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

1048: /*@C
1049:    PetscGetPetscDir - Gets the directory PETSc is installed in

1051:    Not Collective

1053:    Output Parameter:
1054: .  dir - the directory

1056:    Level: developer

1058:    Notes:
1059:     Not for use in Fortran

1061: @*/
1062: PetscErrorCode  PetscGetPetscDir(const char *dir[])
1063: {
1065:   *dir = PETSC_DIR;
1066:   return(0);
1067: }

1069: /*@C
1070:    PetscStrreplace - Replaces substrings in string with other substrings

1072:    Not Collective

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

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

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

1088:       Not for use in Fortran

1090:    Level: intermediate

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

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

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

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

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

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

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

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

1186:    Not Collective

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

1193:    Output Parameters:
1194: +  value - index of matching string (if found)
1195: -  found - boolean indicating whether string was found (can be NULL)

1197:    Notes:
1198:    Not for use in Fortran

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

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

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

1224:    Not Collective

1226:    Input Parameters:
1227: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1228: -  str - string to look for

1230:    Output Parameters:
1231: +  value - index of matching string (if found)
1232: -  found - boolean indicating whether string was found (can be NULL)

1234:    Notes:
1235:    Not for use in Fortran

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

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