Actual source code: str.c

petsc-3.9.0 2018-04-07
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(), PetscStrlcat()

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(), PetscStrlcat()

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(), PetscStrlcat()

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:    PetscStrlcat - 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 - length of the original allocated string

439:    Level: intermediate

441:   Notes:
442:   Not for use in Fortran

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

448:   Concepts: string copy

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

452: @*/
453: PetscErrorCode  PetscStrlcat(char s[],const char t[],size_t n)
454: {
455:   size_t         len;

459:   PetscStrlen(t,&len);
460:   strncat(s,t,n - len);
461:   return(0);
462: }

464: /*

467: */
468: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
469: {
470:   int c;

472:   if (!a && !b)      *flg = PETSC_TRUE;
473:   else if (!a || !b) *flg = PETSC_FALSE;
474:   else {
475:     c = strcmp(a,b);
476:     if (c) *flg = PETSC_FALSE;
477:     else   *flg = PETSC_TRUE;
478:   }
479: }

481: /*@C
482:    PetscStrcmp - Compares two strings,

484:    Not Collective

486:    Input Parameters:
487: +  a - pointer to string first string
488: -  b - pointer to second string

490:    Output Parameter:
491: .  flg - PETSC_TRUE if the two strings are equal

493:    Level: intermediate

495:    Notes:    Not for use in Fortran

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

499: @*/
500: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
501: {
502:   int c;

505:   if (!a && !b)      *flg = PETSC_TRUE;
506:   else if (!a || !b) *flg = PETSC_FALSE;
507:   else {
508:     c = strcmp(a,b);
509:     if (c) *flg = PETSC_FALSE;
510:     else   *flg = PETSC_TRUE;
511:   }
512:   return(0);
513: }

515: /*@C
516:    PetscStrgrt - If first string is greater than the second

518:    Not Collective

520:    Input Parameters:
521: +  a - pointer to first string
522: -  b - pointer to second string

524:    Output Parameter:
525: .  flg - if the first string is greater

527:    Notes:
528:     Null arguments are ok, a null string is considered smaller than
529:     all others

531:    Not for use in Fortran

533:    Level: intermediate

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

537: @*/
538: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
539: {
540:   int c;

543:   if (!a && !b) *t = PETSC_FALSE;
544:   else if (a && !b) *t = PETSC_TRUE;
545:   else if (!a && b) *t = PETSC_FALSE;
546:   else {
547:     c = strcmp(a,b);
548:     if (c > 0) *t = PETSC_TRUE;
549:     else       *t = PETSC_FALSE;
550:   }
551:   return(0);
552: }

554: /*@C
555:    PetscStrcasecmp - Returns true if the two strings are the same
556:      except possibly for case.

558:    Not Collective

560:    Input Parameters:
561: +  a - pointer to first string
562: -  b - pointer to second string

564:    Output Parameter:
565: .  flg - if the two strings are the same

567:    Notes:
568:     Null arguments are ok

570:    Not for use in Fortran

572:    Level: intermediate

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

576: @*/
577: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
578: {
579:   int c;

582:   if (!a && !b) c = 0;
583:   else if (!a || !b) c = 1;
584: #if defined(PETSC_HAVE_STRCASECMP)
585:   else c = strcasecmp(a,b);
586: #elif defined(PETSC_HAVE_STRICMP)
587:   else c = stricmp(a,b);
588: #else
589:   else {
590:     char           *aa,*bb;
592:     PetscStrallocpy(a,&aa);
593:     PetscStrallocpy(b,&bb);
594:     PetscStrtolower(aa);
595:     PetscStrtolower(bb);
596:     PetscStrcmp(aa,bb,t);
597:     PetscFree(aa);
598:     PetscFree(bb);
599:     return(0);
600:   }
601: #endif
602:   if (!c) *t = PETSC_TRUE;
603:   else    *t = PETSC_FALSE;
604:   return(0);
605: }



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

612:    Not Collective

614:    Input Parameters:
615: +  a - pointer to first string
616: .  b - pointer to second string
617: -  n - length to compare up to

619:    Output Parameter:
620: .  t - if the two strings are equal

622:    Level: intermediate

624:    Notes:    Not for use in Fortran

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

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

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

640: /*@C
641:    PetscStrchr - Locates first occurance of a character in a string

643:    Not Collective

645:    Input Parameters:
646: +  a - pointer to string
647: -  b - character

649:    Output Parameter:
650: .  c - location of occurance, NULL if not found

652:    Level: intermediate

654:    Notes:    Not for use in Fortran

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

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

668:    Not Collective

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

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

677:    Level: intermediate

679:    Notes:    Not for use in Fortran

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

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

694:    Not Collective

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

699:    Level: intermediate

701:    Notes:    Not for use in Fortran

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

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

717:    Not Collective

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

722:    Level: intermediate

724:    Notes:    Not for use in Fortran

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

737: /*@C
738:    PetscStrendswith - Determines if a string ends with a certain string

740:    Not Collective

742:    Input Parameters:
743: +  a - pointer to string
744: -  b - string to endwith

746:    Output Parameter:
747: .  flg - PETSC_TRUE or PETSC_FALSE

749:    Notes:     Not for use in Fortran

751:    Level: intermediate

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

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

771: /*@C
772:    PetscStrbeginswith - Determines if a string begins with a certain string

774:    Not Collective

776:    Input Parameters:
777: +  a - pointer to string
778: -  b - string to begin with

780:    Output Parameter:
781: .  flg - PETSC_TRUE or PETSC_FALSE

783:    Notes:     Not for use in Fortran

785:    Level: intermediate

787: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
788:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()

790: @*/
791: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
792: {
793:   char           *test;

797:   *flg = PETSC_FALSE;
798:   PetscStrrstr(a,b,&test);
799:   if (test && (test == a)) *flg = PETSC_TRUE;
800:   return(0);
801: }


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

807:    Not Collective

809:    Input Parameters:
810: +  a - pointer to string
811: -  bs - strings to endwith (last entry must be null)

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

816:    Notes:     Not for use in Fortran

818:    Level: intermediate

820: @*/
821: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
822: {
823:   PetscBool      flg;

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

836: /*@C
837:    PetscStrrstr - Locates last occurance of string in another string

839:    Not Collective

841:    Input Parameters:
842: +  a - pointer to string
843: -  b - string to find

845:    Output Parameter:
846: .  tmp - location of occurance

848:    Notes:     Not for use in Fortran

850:    Level: intermediate

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

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

866: /*@C
867:    PetscStrstr - Locates first occurance of string in another string

869:    Not Collective

871:    Input Parameters:
872: +  haystack - string to search
873: -  needle - string to find

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

878:    Notes: Not for use in Fortran

880:    Level: intermediate

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

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

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

895:    Not Collective

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

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

903:    Notes:

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

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

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

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

916:     Not for use in Fortran

918:    Level: intermediate


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

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

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

951:    Not Collective

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

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

960:    Notes:

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

965:     Not for use in Fortran

967:    Level: intermediate

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

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

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

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

987:    Not Collective

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

992:    Level: intermediate

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

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

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

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

1050:    Not Collective

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

1055:    Level: developer

1057:    Notes: Not for use in Fortran

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

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

1070:    Not Collective

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

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

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

1086:       Not for use in Fortran

1088:    Level: intermediate

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

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

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

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

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

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

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

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

1184:    Not Collective

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

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

1195:    Notes:
1196:    Not for use in Fortran

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

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

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

1222:    Not Collective

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

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

1232:    Notes:
1233:    Not for use in Fortran

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

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