Actual source code: str.c
  1: /*
  2:     We define the string operations here. The reason we just do not use
  3:   the standard string routines in the PETSc code is that on some machines
  4:   they are broken or have the wrong prototypes.
  6: */
  7: #include <petscsys.h>
  8: #if defined(PETSC_HAVE_STRINGS_H)
  9: #  include <strings.h>          /* strcasecmp */
 10: #endif
 12: /*@C
 13:    PetscStrToArray - Separates a string by a character (for example ' ' or '\n') and creates an array of strings
 15:    Not Collective
 17:    Input Parameters:
 18: +  s - pointer to string
 19: -  sp - separator character
 21:    Output Parameter:
 22: +   argc - the number of entries in the array
 23: -   args - an array of the entries with a null at the end
 25:    Level: intermediate
 27:    Notes:
 28:     this may be called before PetscInitialize() or after PetscFinalize()
 30:    Not for use in Fortran
 32:    Developer Notes:
 33:     Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
 34:      to generate argc, args arguments passed to MPI_Init()
 36: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()
 38: @*/
 39: PetscErrorCode  PetscStrToArray(const char s[],char sp,int *argc,char ***args)
 40: {
 41:   int       i,j,n,*lens,cnt = 0;
 42:   PetscBool flg = PETSC_FALSE;
 44:   if (!s) n = 0;
 45:   else    n = strlen(s);
 46:   *argc = 0;
 47:   *args = NULL;
 48:   for (; n>0; n--) {   /* remove separator chars at the end - and will empty the string if all chars are separator chars */
 49:     if (s[n-1] != sp) break;
 50:   }
 51:   if (!n) {
 52:     return(0);
 53:   }
 54:   for (i=0; i<n; i++) {
 55:     if (s[i] != sp) break;
 56:   }
 57:   for (;i<n+1; i++) {
 58:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
 59:     else if (s[i] != sp) {flg = PETSC_FALSE;}
 60:   }
 61:   (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
 62:   lens    = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
 63:   for (i=0; i<*argc; i++) lens[i] = 0;
 65:   *argc = 0;
 66:   for (i=0; i<n; i++) {
 67:     if (s[i] != sp) break;
 68:   }
 69:   for (;i<n+1; i++) {
 70:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
 71:     else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
 72:   }
 74:   for (i=0; i<*argc; i++) {
 75:     (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
 76:     if (!(*args)[i]) {
 77:       free(lens);
 78:       for (j=0; j<i; j++) free((*args)[j]);
 79:       free(*args);
 80:       return PETSC_ERR_MEM;
 81:     }
 82:   }
 83:   free(lens);
 84:   (*args)[*argc] = NULL;
 86:   *argc = 0;
 87:   for (i=0; i<n; i++) {
 88:     if (s[i] != sp) break;
 89:   }
 90:   for (;i<n+1; i++) {
 91:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
 92:     else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
 93:   }
 94:   return 0;
 95: }
 97: /*@C
 98:    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
100:    Not Collective
102:    Output Parameters:
103: +  argc - the number of arguments
104: -  args - the array of arguments
106:    Level: intermediate
108:    Notes:
109:     This may be called before PetscInitialize() or after PetscFinalize()
111:    Not for use in Fortran
113: .seealso: PetscStrToArray()
115: @*/
116: PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
117: {
118:   PetscInt i;
120:   for (i=0; i<argc; i++) free(args[i]);
121:   if (args) free(args);
122:   return 0;
123: }
125: /*@C
126:    PetscStrlen - Gets length of a string
128:    Not Collective
130:    Input Parameters:
131: .  s - pointer to string
133:    Output Parameter:
134: .  len - length in bytes
136:    Level: intermediate
138:    Note:
139:    This routine is analogous to strlen().
141:    Null string returns a length of zero
143:    Not for use in Fortran
145: @*/
146: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
147: {
149:   if (!s) *len = 0;
150:   else    *len = strlen(s);
151:   return(0);
152: }
154: /*@C
155:    PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
157:    Not Collective
159:    Input Parameters:
160: .  s - pointer to string
162:    Output Parameter:
163: .  t - the copied string
165:    Level: intermediate
167:    Note:
168:       Null string returns a new null string
170:       Not for use in Fortran
172:       Warning: If t has previously been allocated then that memory is lost, you may need to PetscFree()
173:       the array before calling this routine.
175: .seealso: PetscStrArrayallocpy(), PetscStrcpy(), PetscStrNArrayallocpy()
177: @*/
178: PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
179: {
181:   size_t         len;
182:   char           *tmp = NULL;
185:   if (s) {
186:     PetscStrlen(s,&len);
187:     PetscMalloc1(1+len,&tmp);
188:     PetscStrcpy(tmp,s);
189:   }
190:   *t = tmp;
191:   return(0);
192: }
194: /*@C
195:    PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
197:    Not Collective
199:    Input Parameters:
200: .  s - pointer to array of strings (final string is a null)
202:    Output Parameter:
203: .  t - the copied array string
205:    Level: intermediate
207:    Note:
208:       Not for use in Fortran
210:       Warning: If t has previously been allocated then that memory is lost, you may need to PetscStrArrayDestroy()
211:       the array before calling this routine.
213: .seealso: PetscStrallocpy(), PetscStrArrayDestroy(), PetscStrNArrayallocpy()
215: @*/
216: PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
217: {
219:   PetscInt       i,n = 0;
222:   while (list[n++]) ;
223:   PetscMalloc1(n+1,t);
224:   for (i=0; i<n; i++) {
225:     PetscStrallocpy(list[i],(*t)+i);
226:   }
227:   (*t)[n] = NULL;
228:   return(0);
229: }
231: /*@C
232:    PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
234:    Not Collective
236:    Output Parameters:
237: .   list - array of strings
239:    Level: intermediate
241:    Notes:
242:     Not for use in Fortran
244: .seealso: PetscStrArrayallocpy()
246: @*/
247: PetscErrorCode PetscStrArrayDestroy(char ***list)
248: {
249:   PetscInt       n = 0;
253:   if (!*list) return(0);
254:   while ((*list)[n]) {
255:     PetscFree((*list)[n]);
256:     n++;
257:   }
258:   PetscFree(*list);
259:   return(0);
260: }
262: /*@C
263:    PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
265:    Not Collective
267:    Input Parameters:
268: +  n - the number of string entries
269: -  s - pointer to array of strings
271:    Output Parameter:
272: .  t - the copied array string
274:    Level: intermediate
276:    Note:
277:       Not for use in Fortran
279: .seealso: PetscStrallocpy(), PetscStrArrayallocpy(), PetscStrNArrayDestroy()
281: @*/
282: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
283: {
285:   PetscInt       i;
288:   PetscMalloc1(n,t);
289:   for (i=0; i<n; i++) {
290:     PetscStrallocpy(list[i],(*t)+i);
291:   }
292:   return(0);
293: }
295: /*@C
296:    PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
298:    Not Collective
300:    Output Parameters:
301: +   n - number of string entries
302: -   list - array of strings
304:    Level: intermediate
306:    Notes:
307:     Not for use in Fortran
309: .seealso: PetscStrArrayallocpy()
311: @*/
312: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
313: {
315:   PetscInt       i;
318:   if (!*list) return(0);
319:   for (i=0; i<n; i++){
320:     PetscFree((*list)[i]);
321:   }
322:   PetscFree(*list);
323:   return(0);
324: }
326: /*@C
327:    PetscStrcpy - Copies a string
329:    Not Collective
331:    Input Parameters:
332: .  t - pointer to string
334:    Output Parameter:
335: .  s - the copied string
337:    Level: intermediate
339:    Notes:
340:      Null string returns a string starting with zero
342:      Not for use in Fortran
344:      It is recommended you use PetscStrncpy() instead of this routine
346: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrlcat()
348: @*/
350: PetscErrorCode  PetscStrcpy(char s[],const char t[])
351: {
353:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
354:   if (t) strcpy(s,t);
355:   else if (s) s[0] = 0;
356:   return(0);
357: }
359: /*@C
360:    PetscStrncpy - Copies a string up to a certain length
362:    Not Collective
364:    Input Parameters:
365: +  t - pointer to string
366: -  n - the length to copy
368:    Output Parameter:
369: .  s - the copied string
371:    Level: intermediate
373:    Note:
374:      Null string returns a string starting with zero
376:      If the string that is being copied is of length n or larger then the entire string is not
377:      copied and the final location of s is set to NULL. This is different then the behavior of
378:      strncpy() which leaves s non-terminated if there is not room for the entire string.
380:   Developers Note: Should this be PetscStrlcpy() to reflect its behavior which is like strlcpy() not strncpy()
382: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrlcat()
384: @*/
385: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
386: {
388:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
389:   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");
390:   if (t) {
391:     if (n > 1) {
392:       strncpy(s,t,n-1);
393:       s[n-1] = '\0';
394:     } else {
395:       s[0] = '\0';
396:     }
397:   } else if (s) s[0] = 0;
398:   return(0);
399: }
401: /*@C
402:    PetscStrcat - Concatenates a string onto a given string
404:    Not Collective
406:    Input Parameters:
407: +  s - string to be added to
408: -  t - pointer to string to be added to end
410:    Level: intermediate
412:    Notes:
413:     Not for use in Fortran
415:     It is recommended you use PetscStrlcat() instead of this routine
417: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrlcat()
419: @*/
420: PetscErrorCode  PetscStrcat(char s[],const char t[])
421: {
423:   if (!t) return(0);
424:   strcat(s,t);
425:   return(0);
426: }
428: /*@C
429:    PetscStrlcat - Concatenates a string onto a given string, up to a given length
431:    Not Collective
433:    Input Parameters:
434: +  s - pointer to string to be added to at end
435: .  t - string to be added
436: -  n - length of the original allocated string
438:    Level: intermediate
440:   Notes:
441:   Not for use in Fortran
443:   Unlike the system call strncat(), the length passed in is the length of the
444:   original allocated space, not the length of the left-over space. This is
445:   similar to the BSD system call strlcat().
447: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
449: @*/
450: PetscErrorCode  PetscStrlcat(char s[],const char t[],size_t n)
451: {
452:   size_t         len;
456:   if (t && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
457:   if (!t) return(0);
458:   PetscStrlen(t,&len);
459:   strncat(s,t,n - len);
460:   s[n-1] = 0;
461:   return(0);
462: }
464: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
465: {
466:   int c;
468:   if (!a && !b)      *flg = PETSC_TRUE;
469:   else if (!a || !b) *flg = PETSC_FALSE;
470:   else {
471:     c = strcmp(a,b);
472:     if (c) *flg = PETSC_FALSE;
473:     else   *flg = PETSC_TRUE;
474:   }
475: }
477: /*@C
478:    PetscStrcmp - Compares two strings,
480:    Not Collective
482:    Input Parameters:
483: +  a - pointer to string first string
484: -  b - pointer to second string
486:    Output Parameter:
487: .  flg - PETSC_TRUE if the two strings are equal
489:    Level: intermediate
491:    Notes:
492:     Not for use in Fortran
494: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
496: @*/
497: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
498: {
499:   int c;
502:   if (!a && !b)      *flg = PETSC_TRUE;
503:   else if (!a || !b) *flg = PETSC_FALSE;
504:   else {
505:     c = strcmp(a,b);
506:     if (c) *flg = PETSC_FALSE;
507:     else   *flg = PETSC_TRUE;
508:   }
509:   return(0);
510: }
512: /*@C
513:    PetscStrgrt - If first string is greater than the second
515:    Not Collective
517:    Input Parameters:
518: +  a - pointer to first string
519: -  b - pointer to second string
521:    Output Parameter:
522: .  flg - if the first string is greater
524:    Notes:
525:     Null arguments are ok, a null string is considered smaller than
526:     all others
528:    Not for use in Fortran
530:    Level: intermediate
532: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
534: @*/
535: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
536: {
537:   int c;
540:   if (!a && !b) *t = PETSC_FALSE;
541:   else if (a && !b) *t = PETSC_TRUE;
542:   else if (!a && b) *t = PETSC_FALSE;
543:   else {
544:     c = strcmp(a,b);
545:     if (c > 0) *t = PETSC_TRUE;
546:     else       *t = PETSC_FALSE;
547:   }
548:   return(0);
549: }
551: /*@C
552:    PetscStrcasecmp - Returns true if the two strings are the same
553:      except possibly for case.
555:    Not Collective
557:    Input Parameters:
558: +  a - pointer to first string
559: -  b - pointer to second string
561:    Output Parameter:
562: .  flg - if the two strings are the same
564:    Notes:
565:     Null arguments are ok
567:    Not for use in Fortran
569:    Level: intermediate
571: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
573: @*/
574: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
575: {
576:   int c;
579:   if (!a && !b) c = 0;
580:   else if (!a || !b) c = 1;
581: #if defined(PETSC_HAVE_STRCASECMP)
582:   else c = strcasecmp(a,b);
583: #elif defined(PETSC_HAVE_STRICMP)
584:   else c = stricmp(a,b);
585: #else
586:   else {
587:     char           *aa,*bb;
589:     PetscStrallocpy(a,&aa);
590:     PetscStrallocpy(b,&bb);
591:     PetscStrtolower(aa);
592:     PetscStrtolower(bb);
593:     PetscStrcmp(aa,bb,t);
594:     PetscFree(aa);
595:     PetscFree(bb);
596:     return(0);
597:   }
598: #endif
599:   if (!c) *t = PETSC_TRUE;
600:   else    *t = PETSC_FALSE;
601:   return(0);
602: }
606: /*@C
607:    PetscStrncmp - Compares two strings, up to a certain length
609:    Not Collective
611:    Input Parameters:
612: +  a - pointer to first string
613: .  b - pointer to second string
614: -  n - length to compare up to
616:    Output Parameter:
617: .  t - if the two strings are equal
619:    Level: intermediate
621:    Notes:
622:     Not for use in Fortran
624: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
626: @*/
627: PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
628: {
629:   int c;
632:   c = strncmp(a,b,n);
633:   if (!c) *t = PETSC_TRUE;
634:   else    *t = PETSC_FALSE;
635:   return(0);
636: }
638: /*@C
639:    PetscStrchr - Locates first occurance of a character in a string
641:    Not Collective
643:    Input Parameters:
644: +  a - pointer to string
645: -  b - character
647:    Output Parameter:
648: .  c - location of occurance, NULL if not found
650:    Level: intermediate
652:    Notes:
653:     Not for use in Fortran
655: @*/
656: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
657: {
659:   *c = (char*)strchr(a,b);
660:   return(0);
661: }
663: /*@C
664:    PetscStrrchr - Locates one location past the last occurance of a character in a string,
665:       if the character is not found then returns entire string
667:    Not Collective
669:    Input Parameters:
670: +  a - pointer to string
671: -  b - character
673:    Output Parameter:
674: .  tmp - location of occurance, a if not found
676:    Level: intermediate
678:    Notes:
679:     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:
702:     Not for use in Fortran
704: @*/
705: PetscErrorCode  PetscStrtolower(char a[])
706: {
708:   while (*a) {
709:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
710:     a++;
711:   }
712:   return(0);
713: }
715: /*@C
716:    PetscStrtoupper - Converts string to upper case
718:    Not Collective
720:    Input Parameters:
721: .  a - pointer to string
723:    Level: intermediate
725:    Notes:
726:     Not for use in Fortran
728: @*/
729: PetscErrorCode  PetscStrtoupper(char a[])
730: {
732:   while (*a) {
733:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
734:     a++;
735:   }
736:   return(0);
737: }
739: /*@C
740:    PetscStrendswith - Determines if a string ends with a certain string
742:    Not Collective
744:    Input Parameters:
745: +  a - pointer to string
746: -  b - string to endwith
748:    Output Parameter:
749: .  flg - PETSC_TRUE or PETSC_FALSE
751:    Notes:
752:     Not for use in Fortran
754:    Level: intermediate
756: @*/
757: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
758: {
759:   char           *test;
761:   size_t         na,nb;
764:   *flg = PETSC_FALSE;
765:   PetscStrrstr(a,b,&test);
766:   if (test) {
767:     PetscStrlen(a,&na);
768:     PetscStrlen(b,&nb);
769:     if (a+na-nb == test) *flg = PETSC_TRUE;
770:   }
771:   return(0);
772: }
774: /*@C
775:    PetscStrbeginswith - Determines if a string begins with a certain string
777:    Not Collective
779:    Input Parameters:
780: +  a - pointer to string
781: -  b - string to begin with
783:    Output Parameter:
784: .  flg - PETSC_TRUE or PETSC_FALSE
786:    Notes:
787:     Not for use in Fortran
789:    Level: intermediate
791: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
792:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()
794: @*/
795: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
796: {
797:   char           *test;
801:   *flg = PETSC_FALSE;
802:   PetscStrrstr(a,b,&test);
803:   if (test && (test == a)) *flg = PETSC_TRUE;
804:   return(0);
805: }
808: /*@C
809:    PetscStrendswithwhich - Determines if a string ends with one of several possible strings
811:    Not Collective
813:    Input Parameters:
814: +  a - pointer to string
815: -  bs - strings to end with (last entry must be NULL)
817:    Output Parameter:
818: .  cnt - the index of the string it ends with or the index of NULL
820:    Notes:
821:     Not for use in Fortran
823:    Level: intermediate
825: @*/
826: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
827: {
828:   PetscBool      flg;
832:   *cnt = 0;
833:   while (bs[*cnt]) {
834:     PetscStrendswith(a,bs[*cnt],&flg);
835:     if (flg) return(0);
836:     *cnt += 1;
837:   }
838:   return(0);
839: }
841: /*@C
842:    PetscStrrstr - Locates last occurance of string in another string
844:    Not Collective
846:    Input Parameters:
847: +  a - pointer to string
848: -  b - string to find
850:    Output Parameter:
851: .  tmp - location of occurance
853:    Notes:
854:     Not for use in Fortran
856:    Level: intermediate
858: @*/
859: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
860: {
861:   const char *stmp = a, *ltmp = NULL;
864:   while (stmp) {
865:     stmp = (char*)strstr(stmp,b);
866:     if (stmp) {ltmp = stmp;stmp++;}
867:   }
868:   *tmp = (char*)ltmp;
869:   return(0);
870: }
872: /*@C
873:    PetscStrstr - Locates first occurance of string in another string
875:    Not Collective
877:    Input Parameters:
878: +  haystack - string to search
879: -  needle - string to find
881:    Output Parameter:
882: .  tmp - location of occurance, is a NULL if the string is not found
884:    Notes:
885:     Not for use in Fortran
887:    Level: intermediate
889: @*/
890: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
891: {
893:   *tmp = (char*)strstr(haystack,needle);
894:   return(0);
895: }
897: struct _p_PetscToken {char token;char *array;char *current;};
899: /*@C
900:    PetscTokenFind - Locates next "token" in a string
902:    Not Collective
904:    Input Parameters:
905: .  a - pointer to token
907:    Output Parameter:
908: .  result - location of occurance, NULL if not found
910:    Notes:
912:      This version is different from the system version in that
913:   it allows you to pass a read-only string into the function.
915:      This version also treats all characters etc. inside a double quote "
916:    as a single token.
918:      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
919:    second will return a null terminated y
921:      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
923:     Not for use in Fortran
925:    Level: intermediate
928: .seealso: PetscTokenCreate(), PetscTokenDestroy()
929: @*/
930: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
931: {
932:   char *ptr = a->current,token;
935:   *result = a->current;
936:   if (ptr && !*ptr) {*result = NULL; return(0);}
937:   token = a->token;
938:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
939:   while (ptr) {
940:     if (*ptr == token) {
941:       *ptr++ = 0;
942:       while (*ptr == a->token) ptr++;
943:       a->current = ptr;
944:       break;
945:     }
946:     if (!*ptr) {
947:       a->current = NULL;
948:       break;
949:     }
950:     ptr++;
951:   }
952:   return(0);
953: }
955: /*@C
956:    PetscTokenCreate - Creates a PetscToken used to find tokens in a string
958:    Not Collective
960:    Input Parameters:
961: +  string - the string to look in
962: -  b - the separator character
964:    Output Parameter:
965: .  t- the token object
967:    Notes:
969:      This version is different from the system version in that
970:   it allows you to pass a read-only string into the function.
972:     Not for use in Fortran
974:    Level: intermediate
976: .seealso: PetscTokenFind(), PetscTokenDestroy()
977: @*/
978: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
979: {
983:   PetscNew(t);
984:   PetscStrallocpy(a,&(*t)->array);
986:   (*t)->current = (*t)->array;
987:   (*t)->token   = b;
988:   return(0);
989: }
991: /*@C
992:    PetscTokenDestroy - Destroys a PetscToken
994:    Not Collective
996:    Input Parameters:
997: .  a - pointer to token
999:    Level: intermediate
1001:    Notes:
1002:     Not for use in Fortran
1004: .seealso: PetscTokenCreate(), PetscTokenFind()
1005: @*/
1006: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
1007: {
1011:   if (!*a) return(0);
1012:   PetscFree((*a)->array);
1013:   PetscFree(*a);
1014:   return(0);
1015: }
1017: /*@C
1018:    PetscStrInList - search string in character-delimited list
1020:    Not Collective
1022:    Input Parameters:
1023: +  str - the string to look for
1024: .  list - the list to search in
1025: -  sep - the separator character
1027:    Output Parameter:
1028: .  found - whether str is in list
1030:    Level: intermediate
1032:    Notes:
1033:     Not for use in Fortran
1035: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
1036: @*/
1037: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
1038: {
1039:   PetscToken     token;
1040:   char           *item;
1044:   *found = PETSC_FALSE;
1045:   PetscTokenCreate(list,sep,&token);
1046:   PetscTokenFind(token,&item);
1047:   while (item) {
1048:     PetscStrcmp(str,item,found);
1049:     if (*found) break;
1050:     PetscTokenFind(token,&item);
1051:   }
1052:   PetscTokenDestroy(&token);
1053:   return(0);
1054: }
1056: /*@C
1057:    PetscGetPetscDir - Gets the directory PETSc is installed in
1059:    Not Collective
1061:    Output Parameter:
1062: .  dir - the directory
1064:    Level: developer
1066:    Notes:
1067:     Not for use in Fortran
1069: @*/
1070: PetscErrorCode  PetscGetPetscDir(const char *dir[])
1071: {
1073:   *dir = PETSC_DIR;
1074:   return(0);
1075: }
1077: /*@C
1078:    PetscStrreplace - Replaces substrings in string with other substrings
1080:    Not Collective
1082:    Input Parameters:
1083: +   comm - MPI_Comm of processors that are processing the string
1084: .   aa - the string to look in
1085: .   b - the resulting copy of a with replaced strings (b can be the same as a)
1086: -   len - the length of b
1088:    Notes:
1089:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
1090:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
1091:       as well as any environmental variables.
1093:       PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
1094:       PETSc was built with and do not use environmental variables.
1096:       Not for use in Fortran
1098:    Level: intermediate
1100: @*/
1101: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1102: {
1104:   int            i = 0;
1105:   size_t         l,l1,l2,l3;
1106:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1107:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",NULL};
1108:   char           *r[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};
1109:   PetscBool      flag;
1110:   static size_t  DISPLAY_LENGTH = 265,USER_LENGTH = 256, HOST_LENGTH = 256;
1113:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1114:   if (aa == b) {
1115:     PetscStrallocpy(aa,(char**)&a);
1116:   }
1117:   PetscMalloc1(len,&work);
1119:   /* get values for replaced variables */
1120:   PetscStrallocpy(PETSC_ARCH,&r[0]);
1121:   PetscStrallocpy(PETSC_DIR,&r[1]);
1122:   PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
1123:   PetscMalloc1(DISPLAY_LENGTH,&r[3]);
1124:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
1125:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
1126:   PetscMalloc1(USER_LENGTH,&r[6]);
1127:   PetscMalloc1(HOST_LENGTH,&r[7]);
1128:   PetscGetDisplay(r[3],DISPLAY_LENGTH);
1129:   PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
1130:   PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
1131:   PetscGetUserName(r[6],USER_LENGTH);
1132:   PetscGetHostName(r[7],HOST_LENGTH);
1134:   /* replace that are in environment */
1135:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,sizeof(env),&flag);
1136:   if (flag) {
1137:     PetscFree(r[2]);
1138:     PetscStrallocpy(env,&r[2]);
1139:   }
1141:   /* replace the requested strings */
1142:   PetscStrncpy(b,a,len);
1143:   while (s[i]) {
1144:     PetscStrlen(s[i],&l);
1145:     PetscStrstr(b,s[i],&par);
1146:     while (par) {
1147:       *par =  0;
1148:       par += l;
1150:       PetscStrlen(b,&l1);
1151:       PetscStrlen(r[i],&l2);
1152:       PetscStrlen(par,&l3);
1153:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1154:       PetscStrncpy(work,b,len);
1155:       PetscStrlcat(work,r[i],len);
1156:       PetscStrlcat(work,par,len);
1157:       PetscStrncpy(b,work,len);
1158:       PetscStrstr(b,s[i],&par);
1159:     }
1160:     i++;
1161:   }
1162:   i = 0;
1163:   while (r[i]) {
1164:     tfree = (char*)r[i];
1165:     PetscFree(tfree);
1166:     i++;
1167:   }
1169:   /* look for any other ${xxx} strings to replace from environmental variables */
1170:   PetscStrstr(b,"${",&par);
1171:   while (par) {
1172:     *par  = 0;
1173:     par  += 2;
1174:     PetscStrncpy(work,b,len);
1175:     PetscStrstr(par,"}",&epar);
1176:     *epar = 0;
1177:     epar += 1;
1178:     PetscOptionsGetenv(comm,par,env,sizeof(env),&flag);
1179:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1180:     PetscStrlcat(work,env,len);
1181:     PetscStrlcat(work,epar,len);
1182:     PetscStrncpy(b,work,len);
1183:     PetscStrstr(b,"${",&par);
1184:   }
1185:   PetscFree(work);
1186:   if (aa == b) {
1187:     PetscFree(a);
1188:   }
1189:   return(0);
1190: }
1192: /*@C
1193:    PetscEListFind - searches list of strings for given string, using case insensitive matching
1195:    Not Collective
1197:    Input Parameters:
1198: +  n - number of strings in
1199: .  list - list of strings to search
1200: -  str - string to look for, empty string "" accepts default (first entry in list)
1202:    Output Parameters:
1203: +  value - index of matching string (if found)
1204: -  found - boolean indicating whether string was found (can be NULL)
1206:    Notes:
1207:    Not for use in Fortran
1209:    Level: advanced
1210: @*/
1211: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
1212: {
1214:   PetscBool matched;
1215:   PetscInt i;
1218:   if (found) *found = PETSC_FALSE;
1219:   for (i=0; i<n; i++) {
1220:     PetscStrcasecmp(str,list[i],&matched);
1221:     if (matched || !str[0]) {
1222:       if (found) *found = PETSC_TRUE;
1223:       *value = i;
1224:       break;
1225:     }
1226:   }
1227:   return(0);
1228: }
1230: /*@C
1231:    PetscEnumFind - searches enum list of strings for given string, using case insensitive matching
1233:    Not Collective
1235:    Input Parameters:
1236: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
1237: -  str - string to look for
1239:    Output Parameters:
1240: +  value - index of matching string (if found)
1241: -  found - boolean indicating whether string was found (can be NULL)
1243:    Notes:
1244:    Not for use in Fortran
1246:    Level: advanced
1247: @*/
1248: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
1249: {
1251:   PetscInt n = 0,evalue;
1252:   PetscBool efound;
1255:   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");
1256:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
1257:   n -= 3; /* drop enum name, prefix, and null termination */
1258:   PetscEListFind(n,enumlist,str,&evalue,&efound);
1259:   if (efound) *value = (PetscEnum)evalue;
1260:   if (found) *found = efound;
1261:   return(0);
1262: }