Actual source code: str.c

petsc-master 2017-03-28
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: this may be called before PetscInitialize() or after PetscFinalize()

 33:    Not for use in Fortran

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

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

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

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

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

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

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

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

102:    Not Collective

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

108:    Level: intermediate

110:    Concepts: command line arguments

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

114:    Not for use in Fortran

116: .seealso: PetscStrToArray()

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

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

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

131:    Not Collective

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

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

139:    Level: intermediate

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

144:    Null string returns a length of zero

146:    Not for use in Fortran

148:   Concepts: string length

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

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

162:    Not Collective

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

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

170:    Level: intermediate

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

175:       Not for use in Fortran

177:   Concepts: string copy

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

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

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

199:    Not Collective

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

204:    Output Parameter:
205: .  t - the copied array string

207:    Level: intermediate

209:    Note:
210:       Not for use in Fortran

212:   Concepts: string copy

214: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

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

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

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

235:    Not Collective

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

240:    Level: intermediate

242:    Concepts: command line arguments

244:    Notes: Not for use in Fortran

246: .seealso: PetscStrArrayallocpy()

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

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

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

267:    Not Collective

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

273:    Output Parameter:
274: .  t - the copied array string

276:    Level: intermediate

278:    Note:
279:       Not for use in Fortran

281:   Concepts: string copy

283: .seealso: PetscStrallocpy() PetscStrArrayDestroy()

285: @*/
286: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
287: {
289:   PetscInt       i;

292:   PetscMalloc1(n,t);
293:   for (i=0; i<n; i++) {
294:     PetscStrallocpy(list[i],(*t)+i);
295:   }
296:   return(0);
297: }

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

302:    Not Collective

304:    Output Parameters:
305: +   n - number of string entries
306: -   list - array of strings

308:    Level: intermediate

310:    Notes: Not for use in Fortran

312: .seealso: PetscStrArrayallocpy()

314: @*/
315: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
316: {
318:   PetscInt       i;

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

329: /*@C
330:    PetscStrcpy - Copies a string

332:    Not Collective

334:    Input Parameters:
335: .  t - pointer to string

337:    Output Parameter:
338: .  s - the copied string

340:    Level: intermediate

342:    Notes:
343:      Null string returns a string starting with zero

345:      Not for use in Fortran

347:   Concepts: string copy

349: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrncat()

351: @*/

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

362: /*@C
363:    PetscStrncpy - Copies a string up to a certain length

365:    Not Collective

367:    Input Parameters:
368: +  t - pointer to string
369: -  n - the length to copy

371:    Output Parameter:
372: .  s - the copied string

374:    Level: intermediate

376:    Note:
377:      Null string returns a string starting with zero

379:      If the string that is being copied is of length n or larger then the entire string is not
380:      copied and the file location of s is set to NULL. This is different then the behavior of 
381:      strncpy() which leaves s non-terminated.

383:   Concepts: string copy

385: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrncat()

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

403: /*@C
404:    PetscStrcat - Concatenates a string onto a given string

406:    Not Collective

408:    Input Parameters:
409: +  s - string to be added to
410: -  t - pointer to string to be added to end

412:    Level: intermediate

414:    Notes: Not for use in Fortran

416:   Concepts: string copy

418: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrncat()

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

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

432:    Not Collective

434:    Input Parameters:
435: +  s - pointer to string to be added to end
436: .  t - string to be added to
437: .  n - maximum length to copy

439:    Level: intermediate

441:   Notes:    Not for use in Fortran

443:   Concepts: string copy

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

447: @*/
448: PetscErrorCode  PetscStrncat(char s[],const char t[],size_t n)
449: {
451:   strncat(s,t,n);
452:   return(0);
453: }

455: /*

458: */
459: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
460: {
461:   int c;

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

472: /*@C
473:    PetscStrcmp - Compares two strings,

475:    Not Collective

477:    Input Parameters:
478: +  a - pointer to string first string
479: -  b - pointer to second string

481:    Output Parameter:
482: .  flg - PETSC_TRUE if the two strings are equal

484:    Level: intermediate

486:    Notes:    Not for use in Fortran

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

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

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

506: /*@C
507:    PetscStrgrt - If first string is greater than the second

509:    Not Collective

511:    Input Parameters:
512: +  a - pointer to first string
513: -  b - pointer to second string

515:    Output Parameter:
516: .  flg - if the first string is greater

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

522:    Not for use in Fortran

524:    Level: intermediate

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

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

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

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

549:    Not Collective

551:    Input Parameters:
552: +  a - pointer to first string
553: -  b - pointer to second string

555:    Output Parameter:
556: .  flg - if the two strings are the same

558:    Notes:
559:     Null arguments are ok

561:    Not for use in Fortran

563:    Level: intermediate

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

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

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



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

603:    Not Collective

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

610:    Output Parameter:
611: .  t - if the two strings are equal

613:    Level: intermediate

615:    Notes:    Not for use in Fortran

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

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

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

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

634:    Not Collective

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

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

643:    Level: intermediate

645:    Notes:    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:    Not for use in Fortran

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

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

685:    Not Collective

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

690:    Level: intermediate

692:    Notes:    Not for use in Fortran

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

705: /*@C
706:    PetscStrtolower - Converts string to upper case

708:    Not Collective

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

713:    Level: intermediate

715:    Notes:    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:     Not for use in Fortran

742:    Level: intermediate

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

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

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

765:    Not Collective

767:    Input Parameters:
768: +  a - pointer to string
769: -  b - string to beginwith

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

774:    Notes:     Not for use in Fortran

776:    Level: intermediate

778: @*/
779: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
780: {
781:   char           *test;

785:   *flg = PETSC_FALSE;
786:   PetscStrrstr(a,b,&test);
787:   if (test && (test == a)) *flg = PETSC_TRUE;
788:   return(0);
789: }


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

795:    Not Collective

797:    Input Parameters:
798: +  a - pointer to string
799: -  bs - strings to endwith (last entry must be null)

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

804:    Notes:     Not for use in Fortran

806:    Level: intermediate

808: @*/
809: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
810: {
811:   PetscBool      flg;

815:   *cnt = 0;
816:   while (bs[*cnt]) {
817:     PetscStrendswith(a,bs[*cnt],&flg);
818:     if (flg) return(0);
819:     *cnt += 1;
820:   }
821:   return(0);
822: }

824: /*@C
825:    PetscStrrstr - Locates last occurance of string in another string

827:    Not Collective

829:    Input Parameters:
830: +  a - pointer to string
831: -  b - string to find

833:    Output Parameter:
834: .  tmp - location of occurance

836:    Notes:     Not for use in Fortran

838:    Level: intermediate

840: @*/
841: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
842: {
843:   const char *stmp = a, *ltmp = 0;

846:   while (stmp) {
847:     stmp = (char*)strstr(stmp,b);
848:     if (stmp) {ltmp = stmp;stmp++;}
849:   }
850:   *tmp = (char*)ltmp;
851:   return(0);
852: }

854: /*@C
855:    PetscStrstr - Locates first occurance of string in another string

857:    Not Collective

859:    Input Parameters:
860: +  haystack - string to search
861: -  needle - string to find

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

866:    Notes: Not for use in Fortran

868:    Level: intermediate

870: @*/
871: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
872: {
874:   *tmp = (char*)strstr(haystack,needle);
875:   return(0);
876: }

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

880: /*@C
881:    PetscTokenFind - Locates next "token" in a string

883:    Not Collective

885:    Input Parameters:
886: .  a - pointer to token

888:    Output Parameter:
889: .  result - location of occurance, NULL if not found

891:    Notes:

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

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

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

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

904:     Not for use in Fortran

906:    Level: intermediate


909: .seealso: PetscTokenCreate(), PetscTokenDestroy()
910: @*/
911: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
912: {
913:   char *ptr = a->current,token;

916:   *result = a->current;
917:   if (ptr && !*ptr) {*result = 0;return(0);}
918:   token = a->token;
919:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
920:   while (ptr) {
921:     if (*ptr == token) {
922:       *ptr++ = 0;
923:       while (*ptr == a->token) ptr++;
924:       a->current = ptr;
925:       break;
926:     }
927:     if (!*ptr) {
928:       a->current = 0;
929:       break;
930:     }
931:     ptr++;
932:   }
933:   return(0);
934: }

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

939:    Not Collective

941:    Input Parameters:
942: +  string - the string to look in
943: -  b - the separator character

945:    Output Parameter:
946: .  t- the token object

948:    Notes:

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

953:     Not for use in Fortran

955:    Level: intermediate

957: .seealso: PetscTokenFind(), PetscTokenDestroy()
958: @*/
959: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
960: {

964:   PetscNew(t);
965:   PetscStrallocpy(a,&(*t)->array);

967:   (*t)->current = (*t)->array;
968:   (*t)->token   = b;
969:   return(0);
970: }

972: /*@C
973:    PetscTokenDestroy - Destroys a PetscToken

975:    Not Collective

977:    Input Parameters:
978: .  a - pointer to token

980:    Level: intermediate

982:    Notes:     Not for use in Fortran

984: .seealso: PetscTokenCreate(), PetscTokenFind()
985: @*/
986: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
987: {

991:   if (!*a) return(0);
992:   PetscFree((*a)->array);
993:   PetscFree(*a);
994:   return(0);
995: }


998: /*@C
999:    PetscGetPetscDir - Gets the directory PETSc is installed in

1001:    Not Collective

1003:    Output Parameter:
1004: .  dir - the directory

1006:    Level: developer

1008:    Notes: Not for use in Fortran

1010: @*/
1011: PetscErrorCode  PetscGetPetscDir(const char *dir[])
1012: {
1014:   *dir = PETSC_DIR;
1015:   return(0);
1016: }

1018: /*@C
1019:    PetscStrreplace - Replaces substrings in string with other substrings

1021:    Not Collective

1023:    Input Parameters:
1024: +   comm - MPI_Comm of processors that are processing the string
1025: .   aa - the string to look in
1026: .   b - the resulting copy of a with replaced strings (b can be the same as a)
1027: -   len - the length of b

1029:    Notes:
1030:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1031:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1032:       as well as any environmental variables.

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

1037:       Not for use in Fortran

1039:    Level: intermediate

1041: @*/
1042: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1043: {
1045:   int            i = 0;
1046:   size_t         l,l1,l2,l3;
1047:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1048:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1049:   const char     *r[] = {0,0,0,0,0,0,0,0,0};
1050:   PetscBool      flag;

1053:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1054:   if (aa == b) {
1055:     PetscStrallocpy(aa,(char**)&a);
1056:   }
1057:   PetscMalloc1(len,&work);

1059:   /* get values for replaced variables */
1060:   PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);
1061:   PetscStrallocpy(PETSC_DIR,(char**)&r[1]);
1062:   PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);
1063:   PetscMalloc1(256,&r[3]);
1064:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1065:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1066:   PetscMalloc1(256,&r[6]);
1067:   PetscMalloc1(256,&r[7]);
1068:   PetscGetDisplay((char*)r[3],256);
1069:   PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);
1070:   PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);
1071:   PetscGetUserName((char*)r[6],256);
1072:   PetscGetHostName((char*)r[7],256);

1074:   /* replace that are in environment */
1075:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);
1076:   if (flag) {
1077:     PetscFree(r[2]);
1078:     PetscStrallocpy(env,(char**)&r[2]);
1079:   }

1081:   /* replace the requested strings */
1082:   PetscStrncpy(b,a,len);
1083:   while (s[i]) {
1084:     PetscStrlen(s[i],&l);
1085:     PetscStrstr(b,s[i],&par);
1086:     while (par) {
1087:       *par =  0;
1088:       par += l;

1090:       PetscStrlen(b,&l1);
1091:       PetscStrlen(r[i],&l2);
1092:       PetscStrlen(par,&l3);
1093:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1094:       PetscStrcpy(work,b);
1095:       PetscStrcat(work,r[i]);
1096:       PetscStrcat(work,par);
1097:       PetscStrncpy(b,work,len);
1098:       PetscStrstr(b,s[i],&par);
1099:     }
1100:     i++;
1101:   }
1102:   i = 0;
1103:   while (r[i]) {
1104:     tfree = (char*)r[i];
1105:     PetscFree(tfree);
1106:     i++;
1107:   }

1109:   /* look for any other ${xxx} strings to replace from environmental variables */
1110:   PetscStrstr(b,"${",&par);
1111:   while (par) {
1112:     *par  = 0;
1113:     par  += 2;
1114:     PetscStrcpy(work,b);
1115:     PetscStrstr(par,"}",&epar);
1116:     *epar = 0;
1117:     epar += 1;
1118:     PetscOptionsGetenv(comm,par,env,256,&flag);
1119:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1120:     PetscStrcat(work,env);
1121:     PetscStrcat(work,epar);
1122:     PetscStrcpy(b,work);
1123:     PetscStrstr(b,"${",&par);
1124:   }
1125:   PetscFree(work);
1126:   if (aa == b) {
1127:     PetscFree(a);
1128:   }
1129:   return(0);
1130: }

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

1135:    Not Collective

1137:    Input Parameters:
1138: +  n - number of strings in
1139: .  list - list of strings to search
1140: -  str - string to look for, empty string "" accepts default (first entry in list)

1142:    Output Parameters:
1143: +  value - index of matching string (if found)
1144: -  found - boolean indicating whether string was found (can be NULL)

1146:    Notes:
1147:    Not for use in Fortran

1149:    Level: advanced
1150: @*/
1151: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1152: {
1154:   PetscBool matched;
1155:   PetscInt i;

1158:   if (found) *found = PETSC_FALSE;
1159:   for (i=0; i<n; i++) {
1160:     PetscStrcasecmp(str,list[i],&matched);
1161:     if (matched || !str[0]) {
1162:       if (found) *found = PETSC_TRUE;
1163:       *value = i;
1164:       break;
1165:     }
1166:   }
1167:   return(0);
1168: }

1170: /*@C
1171:    PetscEListFind - searches enum list of strings for given string, using case insensitive matching

1173:    Not Collective

1175:    Input Parameters:
1176: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1177: -  str - string to look for

1179:    Output Parameters:
1180: +  value - index of matching string (if found)
1181: -  found - boolean indicating whether string was found (can be NULL)

1183:    Notes:
1184:    Not for use in Fortran

1186:    Level: advanced
1187: @*/
1188: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1189: {
1191:   PetscInt n = 0,evalue;
1192:   PetscBool efound;

1195:   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");
1196:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1197:   n -= 3; /* drop enum name, prefix, and null termination */
1198:   PetscEListFind(n,enumlist,str,&evalue,&efound);
1199:   if (efound) *value = (PetscEnum)evalue;
1200:   if (found) *found = efound;
1201:   return(0);
1202: }