Actual source code: str.c

petsc-master 2018-06-20
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:    Concepts: command line arguments

114:    Notes:
115:     This may be called before PetscInitialize() or after PetscFinalize()

117:    Not for use in Fortran

119: .seealso: PetscStrToArray()

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

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

131: /*@C
132:    PetscStrlen - Gets length of a string

134:    Not Collective

136:    Input Parameters:
137: .  s - pointer to string

139:    Output Parameter:
140: .  len - length in bytes

142:    Level: intermediate

144:    Note:
145:    This routine is analogous to strlen().

147:    Null string returns a length of zero

149:    Not for use in Fortran

151:   Concepts: string length

153: @*/
154: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
155: {
157:   if (!s) *len = 0;
158:   else    *len = strlen(s);
159:   return(0);
160: }

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

165:    Not Collective

167:    Input Parameters:
168: .  s - pointer to string

170:    Output Parameter:
171: .  t - the copied string

173:    Level: intermediate

175:    Note:
176:       Null string returns a new null string

178:       Not for use in Fortran

180:   Concepts: string copy

182: @*/
183: PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
184: {
186:   size_t         len;
187:   char           *tmp = 0;

190:   if (s) {
191:     PetscStrlen(s,&len);
192:     PetscMalloc1(1+len,&tmp);
193:     PetscStrcpy(tmp,s);
194:   }
195:   *t = tmp;
196:   return(0);
197: }

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

202:    Not Collective

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

207:    Output Parameter:
208: .  t - the copied array string

210:    Level: intermediate

212:    Note:
213:       Not for use in Fortran

215:   Concepts: string copy

217: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

219: @*/
220: PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
221: {
223:   PetscInt       i,n = 0;

226:   while (list[n++]) ;
227:   PetscMalloc1(n+1,t);
228:   for (i=0; i<n; i++) {
229:     PetscStrallocpy(list[i],(*t)+i);
230:   }
231:   (*t)[n] = NULL;
232:   return(0);
233: }

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

238:    Not Collective

240:    Output Parameters:
241: .   list - array of strings

243:    Level: intermediate

245:    Concepts: command line arguments

247:    Notes:
248:     Not for use in Fortran

250: .seealso: PetscStrArrayallocpy()

252: @*/
253: PetscErrorCode PetscStrArrayDestroy(char ***list)
254: {
255:   PetscInt       n = 0;

259:   if (!*list) return(0);
260:   while ((*list)[n]) {
261:     PetscFree((*list)[n]);
262:     n++;
263:   }
264:   PetscFree(*list);
265:   return(0);
266: }

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

271:    Not Collective

273:    Input Parameters:
274: +  n - the number of string entries
275: -  s - pointer to array of strings

277:    Output Parameter:
278: .  t - the copied array string

280:    Level: intermediate

282:    Note:
283:       Not for use in Fortran

285:   Concepts: string copy

287: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

289: @*/
290: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
291: {
293:   PetscInt       i;

296:   PetscMalloc1(n,t);
297:   for (i=0; i<n; i++) {
298:     PetscStrallocpy(list[i],(*t)+i);
299:   }
300:   return(0);
301: }

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

306:    Not Collective

308:    Output Parameters:
309: +   n - number of string entries
310: -   list - array of strings

312:    Level: intermediate

314:    Notes:
315:     Not for use in Fortran

317: .seealso: PetscStrArrayallocpy()

319: @*/
320: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
321: {
323:   PetscInt       i;

326:   if (!*list) return(0);
327:   for (i=0; i<n; i++){
328:     PetscFree((*list)[i]);
329:   }
330:   PetscFree(*list);
331:   return(0);
332: }

334: /*@C
335:    PetscStrcpy - Copies a string

337:    Not Collective

339:    Input Parameters:
340: .  t - pointer to string

342:    Output Parameter:
343: .  s - the copied string

345:    Level: intermediate

347:    Notes:
348:      Null string returns a string starting with zero

350:      Not for use in Fortran

352:   Concepts: string copy

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

356: @*/

358: PetscErrorCode  PetscStrcpy(char s[],const char t[])
359: {
361:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
362:   if (t) strcpy(s,t);
363:   else if (s) s[0] = 0;
364:   return(0);
365: }

367: /*@C
368:    PetscStrncpy - Copies a string up to a certain length

370:    Not Collective

372:    Input Parameters:
373: +  t - pointer to string
374: -  n - the length to copy

376:    Output Parameter:
377: .  s - the copied string

379:    Level: intermediate

381:    Note:
382:      Null string returns a string starting with zero

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

388:   Concepts: string copy

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

392: @*/
393: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
394: {
396:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
397:   if (t) {
398:     if (n > 1) {
399:       strncpy(s,t,n-1);
400:       s[n-1] = '\0';
401:     } else {
402:       s[0] = '\0';
403:     }
404:   } else if (s) s[0] = 0;
405:   return(0);
406: }

408: /*@C
409:    PetscStrcat - Concatenates a string onto a given string

411:    Not Collective

413:    Input Parameters:
414: +  s - string to be added to
415: -  t - pointer to string to be added to end

417:    Level: intermediate

419:    Notes:
420:     Not for use in Fortran

422:   Concepts: string copy

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

426: @*/
427: PetscErrorCode  PetscStrcat(char s[],const char t[])
428: {
430:   if (!t) return(0);
431:   strcat(s,t);
432:   return(0);
433: }

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

438:    Not Collective

440:    Input Parameters:
441: +  s - pointer to string to be added to end
442: .  t - string to be added to
443: -  n - length of the original allocated string

445:    Level: intermediate

447:   Notes:
448:   Not for use in Fortran

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

454:   Concepts: string copy

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

458: @*/
459: PetscErrorCode  PetscStrlcat(char s[],const char t[],size_t n)
460: {
461:   size_t         len;

465:   PetscStrlen(t,&len);
466:   strncat(s,t,n - len);
467:   return(0);
468: }

470: /*

473: */
474: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
475: {
476:   int c;

478:   if (!a && !b)      *flg = PETSC_TRUE;
479:   else if (!a || !b) *flg = PETSC_FALSE;
480:   else {
481:     c = strcmp(a,b);
482:     if (c) *flg = PETSC_FALSE;
483:     else   *flg = PETSC_TRUE;
484:   }
485: }

487: /*@C
488:    PetscStrcmp - Compares two strings,

490:    Not Collective

492:    Input Parameters:
493: +  a - pointer to string first string
494: -  b - pointer to second string

496:    Output Parameter:
497: .  flg - PETSC_TRUE if the two strings are equal

499:    Level: intermediate

501:    Notes:
502:     Not for use in Fortran

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

506: @*/
507: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
508: {
509:   int c;

512:   if (!a && !b)      *flg = PETSC_TRUE;
513:   else if (!a || !b) *flg = PETSC_FALSE;
514:   else {
515:     c = strcmp(a,b);
516:     if (c) *flg = PETSC_FALSE;
517:     else   *flg = PETSC_TRUE;
518:   }
519:   return(0);
520: }

522: /*@C
523:    PetscStrgrt - If first string is greater than the second

525:    Not Collective

527:    Input Parameters:
528: +  a - pointer to first string
529: -  b - pointer to second string

531:    Output Parameter:
532: .  flg - if the first string is greater

534:    Notes:
535:     Null arguments are ok, a null string is considered smaller than
536:     all others

538:    Not for use in Fortran

540:    Level: intermediate

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

544: @*/
545: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
546: {
547:   int c;

550:   if (!a && !b) *t = PETSC_FALSE;
551:   else if (a && !b) *t = PETSC_TRUE;
552:   else if (!a && b) *t = PETSC_FALSE;
553:   else {
554:     c = strcmp(a,b);
555:     if (c > 0) *t = PETSC_TRUE;
556:     else       *t = PETSC_FALSE;
557:   }
558:   return(0);
559: }

561: /*@C
562:    PetscStrcasecmp - Returns true if the two strings are the same
563:      except possibly for case.

565:    Not Collective

567:    Input Parameters:
568: +  a - pointer to first string
569: -  b - pointer to second string

571:    Output Parameter:
572: .  flg - if the two strings are the same

574:    Notes:
575:     Null arguments are ok

577:    Not for use in Fortran

579:    Level: intermediate

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

583: @*/
584: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
585: {
586:   int c;

589:   if (!a && !b) c = 0;
590:   else if (!a || !b) c = 1;
591: #if defined(PETSC_HAVE_STRCASECMP)
592:   else c = strcasecmp(a,b);
593: #elif defined(PETSC_HAVE_STRICMP)
594:   else c = stricmp(a,b);
595: #else
596:   else {
597:     char           *aa,*bb;
599:     PetscStrallocpy(a,&aa);
600:     PetscStrallocpy(b,&bb);
601:     PetscStrtolower(aa);
602:     PetscStrtolower(bb);
603:     PetscStrcmp(aa,bb,t);
604:     PetscFree(aa);
605:     PetscFree(bb);
606:     return(0);
607:   }
608: #endif
609:   if (!c) *t = PETSC_TRUE;
610:   else    *t = PETSC_FALSE;
611:   return(0);
612: }



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

619:    Not Collective

621:    Input Parameters:
622: +  a - pointer to first string
623: .  b - pointer to second string
624: -  n - length to compare up to

626:    Output Parameter:
627: .  t - if the two strings are equal

629:    Level: intermediate

631:    Notes:
632:     Not for use in Fortran

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

636: @*/
637: PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
638: {
639:   int c;

642:   c = strncmp(a,b,n);
643:   if (!c) *t = PETSC_TRUE;
644:   else    *t = PETSC_FALSE;
645:   return(0);
646: }

648: /*@C
649:    PetscStrchr - Locates first occurance of a character in a string

651:    Not Collective

653:    Input Parameters:
654: +  a - pointer to string
655: -  b - character

657:    Output Parameter:
658: .  c - location of occurance, NULL if not found

660:    Level: intermediate

662:    Notes:
663:     Not for use in Fortran

665: @*/
666: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
667: {
669:   *c = (char*)strchr(a,b);
670:   return(0);
671: }

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

677:    Not Collective

679:    Input Parameters:
680: +  a - pointer to string
681: -  b - character

683:    Output Parameter:
684: .  tmp - location of occurance, a if not found

686:    Level: intermediate

688:    Notes:
689:     Not for use in Fortran

691: @*/
692: PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
693: {
695:   *tmp = (char*)strrchr(a,b);
696:   if (!*tmp) *tmp = (char*)a;
697:   else *tmp = *tmp + 1;
698:   return(0);
699: }

701: /*@C
702:    PetscStrtolower - Converts string to lower case

704:    Not Collective

706:    Input Parameters:
707: .  a - pointer to string

709:    Level: intermediate

711:    Notes:
712:     Not for use in Fortran

714: @*/
715: PetscErrorCode  PetscStrtolower(char a[])
716: {
718:   while (*a) {
719:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
720:     a++;
721:   }
722:   return(0);
723: }

725: /*@C
726:    PetscStrtoupper - Converts string to upper case

728:    Not Collective

730:    Input Parameters:
731: .  a - pointer to string

733:    Level: intermediate

735:    Notes:
736:     Not for use in Fortran

738: @*/
739: PetscErrorCode  PetscStrtoupper(char a[])
740: {
742:   while (*a) {
743:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
744:     a++;
745:   }
746:   return(0);
747: }

749: /*@C
750:    PetscStrendswith - Determines if a string ends with a certain string

752:    Not Collective

754:    Input Parameters:
755: +  a - pointer to string
756: -  b - string to endwith

758:    Output Parameter:
759: .  flg - PETSC_TRUE or PETSC_FALSE

761:    Notes:
762:     Not for use in Fortran

764:    Level: intermediate

766: @*/
767: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
768: {
769:   char           *test;
771:   size_t         na,nb;

774:   *flg = PETSC_FALSE;
775:   PetscStrrstr(a,b,&test);
776:   if (test) {
777:     PetscStrlen(a,&na);
778:     PetscStrlen(b,&nb);
779:     if (a+na-nb == test) *flg = PETSC_TRUE;
780:   }
781:   return(0);
782: }

784: /*@C
785:    PetscStrbeginswith - Determines if a string begins with a certain string

787:    Not Collective

789:    Input Parameters:
790: +  a - pointer to string
791: -  b - string to begin with

793:    Output Parameter:
794: .  flg - PETSC_TRUE or PETSC_FALSE

796:    Notes:
797:     Not for use in Fortran

799:    Level: intermediate

801: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
802:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()

804: @*/
805: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
806: {
807:   char           *test;

811:   *flg = PETSC_FALSE;
812:   PetscStrrstr(a,b,&test);
813:   if (test && (test == a)) *flg = PETSC_TRUE;
814:   return(0);
815: }


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

821:    Not Collective

823:    Input Parameters:
824: +  a - pointer to string
825: -  bs - strings to endwith (last entry must be null)

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

830:    Notes:
831:     Not for use in Fortran

833:    Level: intermediate

835: @*/
836: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
837: {
838:   PetscBool      flg;

842:   *cnt = 0;
843:   while (bs[*cnt]) {
844:     PetscStrendswith(a,bs[*cnt],&flg);
845:     if (flg) return(0);
846:     *cnt += 1;
847:   }
848:   return(0);
849: }

851: /*@C
852:    PetscStrrstr - Locates last occurance of string in another string

854:    Not Collective

856:    Input Parameters:
857: +  a - pointer to string
858: -  b - string to find

860:    Output Parameter:
861: .  tmp - location of occurance

863:    Notes:
864:     Not for use in Fortran

866:    Level: intermediate

868: @*/
869: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
870: {
871:   const char *stmp = a, *ltmp = 0;

874:   while (stmp) {
875:     stmp = (char*)strstr(stmp,b);
876:     if (stmp) {ltmp = stmp;stmp++;}
877:   }
878:   *tmp = (char*)ltmp;
879:   return(0);
880: }

882: /*@C
883:    PetscStrstr - Locates first occurance of string in another string

885:    Not Collective

887:    Input Parameters:
888: +  haystack - string to search
889: -  needle - string to find

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

894:    Notes:
895:     Not for use in Fortran

897:    Level: intermediate

899: @*/
900: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
901: {
903:   *tmp = (char*)strstr(haystack,needle);
904:   return(0);
905: }

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

909: /*@C
910:    PetscTokenFind - Locates next "token" in a string

912:    Not Collective

914:    Input Parameters:
915: .  a - pointer to token

917:    Output Parameter:
918: .  result - location of occurance, NULL if not found

920:    Notes:

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

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

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

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

933:     Not for use in Fortran

935:    Level: intermediate


938: .seealso: PetscTokenCreate(), PetscTokenDestroy()
939: @*/
940: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
941: {
942:   char *ptr = a->current,token;

945:   *result = a->current;
946:   if (ptr && !*ptr) {*result = 0;return(0);}
947:   token = a->token;
948:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
949:   while (ptr) {
950:     if (*ptr == token) {
951:       *ptr++ = 0;
952:       while (*ptr == a->token) ptr++;
953:       a->current = ptr;
954:       break;
955:     }
956:     if (!*ptr) {
957:       a->current = 0;
958:       break;
959:     }
960:     ptr++;
961:   }
962:   return(0);
963: }

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

968:    Not Collective

970:    Input Parameters:
971: +  string - the string to look in
972: -  b - the separator character

974:    Output Parameter:
975: .  t- the token object

977:    Notes:

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

982:     Not for use in Fortran

984:    Level: intermediate

986: .seealso: PetscTokenFind(), PetscTokenDestroy()
987: @*/
988: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
989: {

993:   PetscNew(t);
994:   PetscStrallocpy(a,&(*t)->array);

996:   (*t)->current = (*t)->array;
997:   (*t)->token   = b;
998:   return(0);
999: }

1001: /*@C
1002:    PetscTokenDestroy - Destroys a PetscToken

1004:    Not Collective

1006:    Input Parameters:
1007: .  a - pointer to token

1009:    Level: intermediate

1011:    Notes:
1012:     Not for use in Fortran

1014: .seealso: PetscTokenCreate(), PetscTokenFind()
1015: @*/
1016: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
1017: {

1021:   if (!*a) return(0);
1022:   PetscFree((*a)->array);
1023:   PetscFree(*a);
1024:   return(0);
1025: }

1027: /*@C
1028:    PetscStrInList - search string in character-delimited list

1030:    Not Collective

1032:    Input Parameters:
1033: +  str - the string to look for
1034: .  list - the list to search in
1035: -  sep - the separator character

1037:    Output Parameter:
1038: .  found - whether str is in list

1040:    Level: intermediate

1042:    Notes:
1043:     Not for use in Fortran

1045: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1046: @*/
1047: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1048: {
1049:   PetscToken     token;
1050:   char           *item;

1054:   *found = PETSC_FALSE;
1055:   PetscTokenCreate(list,sep,&token);
1056:   PetscTokenFind(token,&item);
1057:   while (item) {
1058:     PetscStrcmp(str,item,found);
1059:     if (*found) break;
1060:     PetscTokenFind(token,&item);
1061:   }
1062:   PetscTokenDestroy(&token);
1063:   return(0);
1064: }

1066: /*@C
1067:    PetscGetPetscDir - Gets the directory PETSc is installed in

1069:    Not Collective

1071:    Output Parameter:
1072: .  dir - the directory

1074:    Level: developer

1076:    Notes:
1077:     Not for use in Fortran

1079: @*/
1080: PetscErrorCode  PetscGetPetscDir(const char *dir[])
1081: {
1083:   *dir = PETSC_DIR;
1084:   return(0);
1085: }

1087: /*@C
1088:    PetscStrreplace - Replaces substrings in string with other substrings

1090:    Not Collective

1092:    Input Parameters:
1093: +   comm - MPI_Comm of processors that are processing the string
1094: .   aa - the string to look in
1095: .   b - the resulting copy of a with replaced strings (b can be the same as a)
1096: -   len - the length of b

1098:    Notes:
1099:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1100:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1101:       as well as any environmental variables.

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

1106:       Not for use in Fortran

1108:    Level: intermediate

1110: @*/
1111: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1112: {
1114:   int            i = 0;
1115:   size_t         l,l1,l2,l3;
1116:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1117:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1118:   char           *r[] = {0,0,0,0,0,0,0,0,0};
1119:   PetscBool      flag;

1122:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1123:   if (aa == b) {
1124:     PetscStrallocpy(aa,(char**)&a);
1125:   }
1126:   PetscMalloc1(len,&work);

1128:   /* get values for replaced variables */
1129:   PetscStrallocpy(PETSC_ARCH,&r[0]);
1130:   PetscStrallocpy(PETSC_DIR,&r[1]);
1131:   PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
1132:   PetscMalloc1(256,&r[3]);
1133:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1134:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1135:   PetscMalloc1(256,&r[6]);
1136:   PetscMalloc1(256,&r[7]);
1137:   PetscGetDisplay(r[3],256);
1138:   PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
1139:   PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
1140:   PetscGetUserName(r[6],256);
1141:   PetscGetHostName(r[7],256);

1143:   /* replace that are in environment */
1144:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1145:   if (flag) {
1146:     PetscFree(r[2]);
1147:     PetscStrallocpy(env,&r[2]);
1148:   }

1150:   /* replace the requested strings */
1151:   PetscStrncpy(b,a,len);
1152:   while (s[i]) {
1153:     PetscStrlen(s[i],&l);
1154:     PetscStrstr(b,s[i],&par);
1155:     while (par) {
1156:       *par =  0;
1157:       par += l;

1159:       PetscStrlen(b,&l1);
1160:       PetscStrlen(r[i],&l2);
1161:       PetscStrlen(par,&l3);
1162:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1163:       PetscStrcpy(work,b);
1164:       PetscStrcat(work,r[i]);
1165:       PetscStrcat(work,par);
1166:       PetscStrncpy(b,work,len);
1167:       PetscStrstr(b,s[i],&par);
1168:     }
1169:     i++;
1170:   }
1171:   i = 0;
1172:   while (r[i]) {
1173:     tfree = (char*)r[i];
1174:     PetscFree(tfree);
1175:     i++;
1176:   }

1178:   /* look for any other ${xxx} strings to replace from environmental variables */
1179:   PetscStrstr(b,"${",&par);
1180:   while (par) {
1181:     *par  = 0;
1182:     par  += 2;
1183:     PetscStrcpy(work,b);
1184:     PetscStrstr(par,"}",&epar);
1185:     *epar = 0;
1186:     epar += 1;
1187:     PetscOptionsGetenv(comm,par,env,256,&flag);
1188:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1189:     PetscStrcat(work,env);
1190:     PetscStrcat(work,epar);
1191:     PetscStrcpy(b,work);
1192:     PetscStrstr(b,"${",&par);
1193:   }
1194:   PetscFree(work);
1195:   if (aa == b) {
1196:     PetscFree(a);
1197:   }
1198:   return(0);
1199: }

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

1204:    Not Collective

1206:    Input Parameters:
1207: +  n - number of strings in
1208: .  list - list of strings to search
1209: -  str - string to look for, empty string "" accepts default (first entry in list)

1211:    Output Parameters:
1212: +  value - index of matching string (if found)
1213: -  found - boolean indicating whether string was found (can be NULL)

1215:    Notes:
1216:    Not for use in Fortran

1218:    Level: advanced
1219: @*/
1220: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1221: {
1223:   PetscBool matched;
1224:   PetscInt i;

1227:   if (found) *found = PETSC_FALSE;
1228:   for (i=0; i<n; i++) {
1229:     PetscStrcasecmp(str,list[i],&matched);
1230:     if (matched || !str[0]) {
1231:       if (found) *found = PETSC_TRUE;
1232:       *value = i;
1233:       break;
1234:     }
1235:   }
1236:   return(0);
1237: }

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

1242:    Not Collective

1244:    Input Parameters:
1245: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1246: -  str - string to look for

1248:    Output Parameters:
1249: +  value - index of matching string (if found)
1250: -  found - boolean indicating whether string was found (can be NULL)

1252:    Notes:
1253:    Not for use in Fortran

1255:    Level: advanced
1256: @*/
1257: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1258: {
1260:   PetscInt n = 0,evalue;
1261:   PetscBool efound;

1264:   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");
1265:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1266:   n -= 3; /* drop enum name, prefix, and null termination */
1267:   PetscEListFind(n,enumlist,str,&evalue,&efound);
1268:   if (efound) *value = (PetscEnum)evalue;
1269:   if (found) *found = efound;
1270:   return(0);
1271: }