xref: /petsc/src/sys/utils/str.c (revision 18e2ec274b9e92144f2ef650b9690aa28f9a6737)
1 
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.
6 
7 */
8 #include <petscsys.h>                   /*I  "petscsys.h"   I*/
9 #if defined(PETSC_HAVE_STRING_H)
10 #include <string.h>
11 #endif
12 #if defined(PETSC_HAVE_STRINGS_H)
13 #include <strings.h>
14 #endif
15 
16 #undef __FUNCT__
17 #define __FUNCT__ "PetscStrToArray"
18 /*@C
19    PetscStrToArray - Seperates a string by a charactor (for example ' ' or '\n') and creates an array of strings
20 
21    Not Collective
22 
23    Input Parameters:
24 +  s - pointer to string
25 -  sp - separator charactor
26 
27    Output Parameter:
28 +   argc - the number of entries in the array
29 -   args - an array of the entries with a null at the end
30 
31    Level: intermediate
32 
33    Notes: this may be called before PetscInitialize() or after PetscFinalize()
34 
35    Not for use in Fortran
36 
37    Developer Notes: 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()
39 
40 .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()
41 
42 @*/
43 PetscErrorCode  PetscStrToArray(const char s[],char sp,int *argc,char ***args)
44 {
45   int        i,n,*lens,cnt = 0;
46   PetscBool  flg = PETSC_FALSE;
47 
48   if (!s) n = 0;
49   else    n = strlen(s);
50   *argc = 0;
51   if (!n) {
52     *args = 0;
53     return(0);
54   }
55   for (i=0; i<n; i++) {
56     if (s[i] != sp) break;
57   }
58   for (;i<n+1; i++) {
59     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
60     else if (s[i] != sp) {flg = PETSC_FALSE;}
61   }
62   (*args) = (char **) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
63   lens    = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
64   for (i=0; i<*argc; i++) lens[i] = 0;
65 
66   *argc = 0;
67   for (i=0; i<n; i++) {
68     if (s[i] != sp) break;
69   }
70   for (;i<n+1; i++) {
71     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
72     else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
73   }
74 
75   for (i=0; i<*argc; i++) {
76     (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char)); if (!(*args)[i]) return PETSC_ERR_MEM;
77   }
78   free(lens);
79   (*args)[*argc] = 0;
80 
81   *argc = 0;
82   for (i=0; i<n; i++) {
83     if (s[i] != sp) break;
84   }
85   for (;i<n+1; i++) {
86     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
87     else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
88   }
89   return 0;
90 }
91 
92 #undef __FUNCT__
93 #define __FUNCT__ "PetscStrToArrayDestroy"
94 /*@C
95    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().
96 
97    Not Collective
98 
99    Output Parameters:
100 +  argc - the number of arguments
101 -  args - the array of arguments
102 
103    Level: intermediate
104 
105    Concepts: command line arguments
106 
107    Notes: This may be called before PetscInitialize() or after PetscFinalize()
108 
109    Not for use in Fortran
110 
111 .seealso: PetscStrToArray()
112 
113 @*/
114 PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
115 {
116   PetscInt i;
117 
118   for (i=0; i<argc; i++) {
119     free(args[i]);
120   }
121   if (args) {
122     free(args);
123   }
124   return 0;
125 }
126 
127 #undef __FUNCT__
128 #define __FUNCT__ "PetscStrlen"
129 /*@C
130    PetscStrlen - Gets length of a string
131 
132    Not Collective
133 
134    Input Parameters:
135 .  s - pointer to string
136 
137    Output Parameter:
138 .  len - length in bytes
139 
140    Level: intermediate
141 
142    Note:
143    This routine is analogous to strlen().
144 
145    Null string returns a length of zero
146 
147    Not for use in Fortran
148 
149   Concepts: string length
150 
151 @*/
152 PetscErrorCode  PetscStrlen(const char s[],size_t *len)
153 {
154   PetscFunctionBegin;
155   if (!s) {
156     *len = 0;
157   } else {
158     *len = strlen(s);
159   }
160   PetscFunctionReturn(0);
161 }
162 
163 #undef __FUNCT__
164 #define __FUNCT__ "PetscStrallocpy"
165 /*@C
166    PetscStrallocpy - Allocates space to hold a copy of a string then copies the string
167 
168    Not Collective
169 
170    Input Parameters:
171 .  s - pointer to string
172 
173    Output Parameter:
174 .  t - the copied string
175 
176    Level: intermediate
177 
178    Note:
179       Null string returns a new null string
180 
181       Not for use in Fortran
182 
183   Concepts: string copy
184 
185 @*/
186 PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
187 {
188   PetscErrorCode ierr;
189   size_t         len;
190   char           *tmp = 0;
191 
192   PetscFunctionBegin;
193   if (s) {
194     ierr = PetscStrlen(s,&len);CHKERRQ(ierr);
195     ierr = PetscMalloc((1+len)*sizeof(char),&tmp);CHKERRQ(ierr);
196     ierr = PetscStrcpy(tmp,s);CHKERRQ(ierr);
197   }
198   *t = tmp;
199   PetscFunctionReturn(0);
200 }
201 
202 #undef __FUNCT__
203 #define __FUNCT__ "PetscStrArrayallocpy"
204 /*@C
205    PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings
206 
207    Not Collective
208 
209    Input Parameters:
210 .  s - pointer to array of strings (final string is a null)
211 
212    Output Parameter:
213 .  t - the copied array string
214 
215    Level: intermediate
216 
217    Note:
218       Not for use in Fortran
219 
220   Concepts: string copy
221 
222 .seealso: PetscStrallocpy() PetscStrArrayDestroy()
223 
224 @*/
225 PetscErrorCode  PetscStrArrayallocpy(const char *const*list,char ***t)
226 {
227   PetscErrorCode ierr;
228   PetscInt       i,n = 0;
229 
230   PetscFunctionBegin;
231   while (list[n++]) ;
232   ierr = PetscMalloc((n+1)*sizeof(char**),t);CHKERRQ(ierr);
233   for (i=0; i<n; i++) {
234     ierr = PetscStrallocpy(list[i],(*t)+i);CHKERRQ(ierr);
235   }
236   (*t)[n] = PETSC_NULL;
237   PetscFunctionReturn(0);
238 }
239 
240 #undef __FUNCT__
241 #define __FUNCT__ "PetscStrArrayDestroy"
242 /*@C
243    PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().
244 
245    Not Collective
246 
247    Output Parameters:
248 .   list - array of strings
249 
250    Level: intermediate
251 
252    Concepts: command line arguments
253 
254    Notes: Not for use in Fortran
255 
256 .seealso: PetscStrArrayallocpy()
257 
258 @*/
259 PetscErrorCode PetscStrArrayDestroy(char ***list)
260 {
261   PetscInt       n = 0;
262   PetscErrorCode ierr;
263 
264   PetscFunctionBegin;
265   if (!*list) PetscFunctionReturn(0);
266   while ((*list)[n]) {
267     ierr = PetscFree((*list)[n]);CHKERRQ(ierr);
268     n++;
269   }
270   ierr = PetscFree(*list);CHKERRQ(ierr);
271   PetscFunctionReturn(0);
272 }
273 
274 #undef __FUNCT__
275 #define __FUNCT__ "PetscStrcpy"
276 /*@C
277    PetscStrcpy - Copies a string
278 
279    Not Collective
280 
281    Input Parameters:
282 .  t - pointer to string
283 
284    Output Parameter:
285 .  s - the copied string
286 
287    Level: intermediate
288 
289    Notes:
290      Null string returns a string starting with zero
291 
292      Not for use in Fortran
293 
294   Concepts: string copy
295 
296 .seealso: PetscStrncpy(), PetscStrcat(), PetscStrncat()
297 
298 @*/
299 
300 PetscErrorCode  PetscStrcpy(char s[],const char t[])
301 {
302   PetscFunctionBegin;
303   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
304   if (t) {strcpy(s,t);}
305   else if (s) {s[0] = 0;}
306   PetscFunctionReturn(0);
307 }
308 
309 #undef __FUNCT__
310 #define __FUNCT__ "PetscStrncpy"
311 /*@C
312    PetscStrncpy - Copies a string up to a certain length
313 
314    Not Collective
315 
316    Input Parameters:
317 +  t - pointer to string
318 -  n - the length to copy
319 
320    Output Parameter:
321 .  s - the copied string
322 
323    Level: intermediate
324 
325    Note:
326      Null string returns a string starting with zero
327 
328   Concepts: string copy
329 
330 .seealso: PetscStrcpy(), PetscStrcat(), PetscStrncat()
331 
332 @*/
333 PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
334 {
335   PetscFunctionBegin;
336   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
337   if (t) {strncpy(s,t,n);}
338   else if (s) {s[0] = 0;}
339   PetscFunctionReturn(0);
340 }
341 
342 #undef __FUNCT__
343 #define __FUNCT__ "PetscStrcat"
344 /*@C
345    PetscStrcat - Concatenates a string onto a given string
346 
347    Not Collective
348 
349    Input Parameters:
350 +  s - string to be added to
351 -  t - pointer to string to be added to end
352 
353    Level: intermediate
354 
355    Notes: Not for use in Fortran
356 
357   Concepts: string copy
358 
359 .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrncat()
360 
361 @*/
362 PetscErrorCode  PetscStrcat(char s[],const char t[])
363 {
364   PetscFunctionBegin;
365   if (!t) PetscFunctionReturn(0);
366   strcat(s,t);
367   PetscFunctionReturn(0);
368 }
369 
370 #undef __FUNCT__
371 #define __FUNCT__ "PetscStrncat"
372 /*@C
373    PetscStrncat - Concatenates a string onto a given string, up to a given length
374 
375    Not Collective
376 
377    Input Parameters:
378 +  s - pointer to string to be added to end
379 .  t - string to be added to
380 .  n - maximum length to copy
381 
382    Level: intermediate
383 
384   Notes:    Not for use in Fortran
385 
386   Concepts: string copy
387 
388 .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()
389 
390 @*/
391 PetscErrorCode  PetscStrncat(char s[],const char t[],size_t n)
392 {
393   PetscFunctionBegin;
394   strncat(s,t,n);
395   PetscFunctionReturn(0);
396 }
397 
398 #undef __FUNCT__
399 #define __FUNCT__ "PetscStrcmp"
400 /*@C
401    PetscStrcmp - Compares two strings,
402 
403    Not Collective
404 
405    Input Parameters:
406 +  a - pointer to string first string
407 -  b - pointer to second string
408 
409    Output Parameter:
410 .  flg - PETSC_TRUE if the two strings are equal
411 
412    Level: intermediate
413 
414    Notes:    Not for use in Fortran
415 
416 .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()
417 
418 @*/
419 PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
420 {
421   int c;
422 
423   PetscFunctionBegin;
424   if (!a && !b) {
425     *flg = PETSC_TRUE;
426   } else if (!a || !b) {
427     *flg = PETSC_FALSE;
428   } else {
429     c = strcmp(a,b);
430     if (c) *flg = PETSC_FALSE;
431     else   *flg = PETSC_TRUE;
432   }
433   PetscFunctionReturn(0);
434 }
435 
436 #undef __FUNCT__
437 #define __FUNCT__ "PetscStrgrt"
438 /*@C
439    PetscStrgrt - If first string is greater than the second
440 
441    Not Collective
442 
443    Input Parameters:
444 +  a - pointer to first string
445 -  b - pointer to second string
446 
447    Output Parameter:
448 .  flg - if the first string is greater
449 
450    Notes:
451     Null arguments are ok, a null string is considered smaller than
452     all others
453 
454    Not for use in Fortran
455 
456    Level: intermediate
457 
458 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()
459 
460 @*/
461 PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
462 {
463   int c;
464 
465   PetscFunctionBegin;
466   if (!a && !b) {
467     *t = PETSC_FALSE;
468   } else if (a && !b) {
469     *t = PETSC_TRUE;
470   } else if (!a && b) {
471     *t = PETSC_FALSE;
472   } else {
473     c = strcmp(a,b);
474     if (c > 0) *t = PETSC_TRUE;
475     else       *t = PETSC_FALSE;
476   }
477   PetscFunctionReturn(0);
478 }
479 
480 #undef __FUNCT__
481 #define __FUNCT__ "PetscStrcasecmp"
482 /*@C
483    PetscStrcasecmp - Returns true if the two strings are the same
484      except possibly for case.
485 
486    Not Collective
487 
488    Input Parameters:
489 +  a - pointer to first string
490 -  b - pointer to second string
491 
492    Output Parameter:
493 .  flg - if the two strings are the same
494 
495    Notes:
496     Null arguments are ok
497 
498    Not for use in Fortran
499 
500    Level: intermediate
501 
502 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()
503 
504 @*/
505 PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
506 {
507   int c;
508 
509   PetscFunctionBegin;
510   if (!a && !b) c = 0;
511   else if (!a || !b) c = 1;
512 #if defined(PETSC_HAVE_STRCASECMP)
513   else c = strcasecmp(a,b);
514 #elif defined(PETSC_HAVE_STRICMP)
515   else c = stricmp(a,b);
516 #else
517   else {
518     char           *aa,*bb;
519     PetscErrorCode ierr;
520     ierr = PetscStrallocpy(a,&aa);CHKERRQ(ierr);
521     ierr = PetscStrallocpy(b,&bb);CHKERRQ(ierr);
522     ierr = PetscStrtolower(aa);CHKERRQ(ierr);
523     ierr = PetscStrtolower(bb);CHKERRQ(ierr);
524     ierr = PetscStrcmp(aa,bb,t);CHKERRQ(ierr);
525     ierr = PetscFree(aa);CHKERRQ(ierr);
526     ierr = PetscFree(bb);CHKERRQ(ierr);
527     PetscFunctionReturn(0);
528   }
529 #endif
530   if (!c) *t = PETSC_TRUE;
531   else    *t = PETSC_FALSE;
532   PetscFunctionReturn(0);
533 }
534 
535 
536 
537 #undef __FUNCT__
538 #define __FUNCT__ "PetscStrncmp"
539 /*@C
540    PetscStrncmp - Compares two strings, up to a certain length
541 
542    Not Collective
543 
544    Input Parameters:
545 +  a - pointer to first string
546 .  b - pointer to second string
547 -  n - length to compare up to
548 
549    Output Parameter:
550 .  t - if the two strings are equal
551 
552    Level: intermediate
553 
554    Notes:    Not for use in Fortran
555 
556 .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()
557 
558 @*/
559 PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
560 {
561   int c;
562 
563   PetscFunctionBegin;
564   c = strncmp(a,b,n);
565   if (!c) *t = PETSC_TRUE;
566   else    *t = PETSC_FALSE;
567   PetscFunctionReturn(0);
568 }
569 
570 #undef __FUNCT__
571 #define __FUNCT__ "PetscStrchr"
572 /*@C
573    PetscStrchr - Locates first occurance of a character in a string
574 
575    Not Collective
576 
577    Input Parameters:
578 +  a - pointer to string
579 -  b - character
580 
581    Output Parameter:
582 .  c - location of occurance, PETSC_NULL if not found
583 
584    Level: intermediate
585 
586    Notes:    Not for use in Fortran
587 
588 @*/
589 PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
590 {
591   PetscFunctionBegin;
592   *c = (char *)strchr(a,b);
593   PetscFunctionReturn(0);
594 }
595 
596 #undef __FUNCT__
597 #define __FUNCT__ "PetscStrrchr"
598 /*@C
599    PetscStrrchr - Locates one location past the last occurance of a character in a string,
600       if the character is not found then returns entire string
601 
602    Not Collective
603 
604    Input Parameters:
605 +  a - pointer to string
606 -  b - character
607 
608    Output Parameter:
609 .  tmp - location of occurance, a if not found
610 
611    Level: intermediate
612 
613    Notes:    Not for use in Fortran
614 
615 @*/
616 PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
617 {
618   PetscFunctionBegin;
619   *tmp = (char *)strrchr(a,b);
620   if (!*tmp) *tmp = (char*)a; else *tmp = *tmp + 1;
621   PetscFunctionReturn(0);
622 }
623 
624 #undef __FUNCT__
625 #define __FUNCT__ "PetscStrtolower"
626 /*@C
627    PetscStrtolower - Converts string to lower case
628 
629    Not Collective
630 
631    Input Parameters:
632 .  a - pointer to string
633 
634    Level: intermediate
635 
636    Notes:    Not for use in Fortran
637 
638 @*/
639 PetscErrorCode  PetscStrtolower(char a[])
640 {
641   PetscFunctionBegin;
642   while (*a) {
643     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
644     a++;
645   }
646   PetscFunctionReturn(0);
647 }
648 
649 #undef __FUNCT__
650 #define __FUNCT__ "PetscStrtoupper"
651 /*@C
652    PetscStrtolower - Converts string to upper case
653 
654    Not Collective
655 
656    Input Parameters:
657 .  a - pointer to string
658 
659    Level: intermediate
660 
661    Notes:    Not for use in Fortran
662 
663 @*/
664 PetscErrorCode  PetscStrtoupper(char a[])
665 {
666   PetscFunctionBegin;
667   while (*a) {
668     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
669     a++;
670   }
671   PetscFunctionReturn(0);
672 }
673 
674 #undef __FUNCT__
675 #define __FUNCT__ "PetscStrendswith"
676 /*@C
677    PetscStrendswith - Determines if a string ends with a certain string
678 
679    Not Collective
680 
681    Input Parameters:
682 +  a - pointer to string
683 -  b - string to endwith
684 
685    Output Parameter:
686 .  flg - PETSC_TRUE or PETSC_FALSE
687 
688    Notes:     Not for use in Fortran
689 
690    Level: intermediate
691 
692 @*/
693 PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
694 {
695   char           *test;
696   PetscErrorCode ierr;
697   size_t         na,nb;
698 
699   PetscFunctionBegin;
700   *flg = PETSC_FALSE;
701   ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr);
702   if (test) {
703     ierr = PetscStrlen(a,&na);CHKERRQ(ierr);
704     ierr = PetscStrlen(b,&nb);CHKERRQ(ierr);
705     if (a+na-nb == test) *flg = PETSC_TRUE;
706   }
707   PetscFunctionReturn(0);
708 }
709 
710 #undef __FUNCT__
711 #define __FUNCT__ "PetscStrbeginswith"
712 /*@C
713    PetscStrbeginswith - Determines if a string begins with a certain string
714 
715    Not Collective
716 
717    Input Parameters:
718 +  a - pointer to string
719 -  b - string to beginwith
720 
721    Output Parameter:
722 .  flg - PETSC_TRUE or PETSC_FALSE
723 
724    Notes:     Not for use in Fortran
725 
726    Level: intermediate
727 
728 @*/
729 PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
730 {
731   char           *test;
732   PetscErrorCode ierr;
733 
734   PetscFunctionBegin;
735   *flg = PETSC_FALSE;
736   ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr);
737   if (test && (test == a)) {
738     *flg = PETSC_TRUE;
739   }
740   PetscFunctionReturn(0);
741 }
742 
743 
744 #undef __FUNCT__
745 #define __FUNCT__ "PetscStrendswithwhich"
746 /*@C
747    PetscStrendswithwhich - Determines if a string ends with one of several possible strings
748 
749    Not Collective
750 
751    Input Parameters:
752 +  a - pointer to string
753 -  bs - strings to endwith (last entry must be null)
754 
755    Output Parameter:
756 .  cnt - the index of the string it ends with or 1+the last possible index
757 
758    Notes:     Not for use in Fortran
759 
760    Level: intermediate
761 
762 @*/
763 PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
764 {
765   PetscBool      flg;
766   PetscErrorCode ierr;
767 
768   PetscFunctionBegin;
769   *cnt = 0;
770   while (bs[*cnt]) {
771     ierr = PetscStrendswith(a,bs[*cnt],&flg);CHKERRQ(ierr);
772     if (flg) PetscFunctionReturn(0);
773     *cnt += 1;
774   }
775   PetscFunctionReturn(0);
776 }
777 
778 #undef __FUNCT__
779 #define __FUNCT__ "PetscStrrstr"
780 /*@C
781    PetscStrrstr - Locates last occurance of string in another string
782 
783    Not Collective
784 
785    Input Parameters:
786 +  a - pointer to string
787 -  b - string to find
788 
789    Output Parameter:
790 .  tmp - location of occurance
791 
792    Notes:     Not for use in Fortran
793 
794    Level: intermediate
795 
796 @*/
797 PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
798 {
799   const char *stmp = a, *ltmp = 0;
800 
801   PetscFunctionBegin;
802   while (stmp) {
803     stmp = (char *)strstr(stmp,b);
804     if (stmp) {ltmp = stmp;stmp++;}
805   }
806   *tmp = (char *)ltmp;
807   PetscFunctionReturn(0);
808 }
809 
810 #undef __FUNCT__
811 #define __FUNCT__ "PetscStrstr"
812 /*@C
813    PetscStrstr - Locates first occurance of string in another string
814 
815    Not Collective
816 
817    Input Parameters:
818 +  haystack - string to search
819 -  needle - string to find
820 
821    Output Parameter:
822 .  tmp - location of occurance, is a PETSC_NULL if the string is not found
823 
824    Notes: Not for use in Fortran
825 
826    Level: intermediate
827 
828 @*/
829 PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
830 {
831   PetscFunctionBegin;
832   *tmp = (char *)strstr(haystack,needle);
833   PetscFunctionReturn(0);
834 }
835 
836 struct _p_PetscToken {char token;char *array;char *current;};
837 
838 #undef __FUNCT__
839 #define __FUNCT__ "PetscTokenFind"
840 /*@C
841    PetscTokenFind - Locates next "token" in a string
842 
843    Not Collective
844 
845    Input Parameters:
846 .  a - pointer to token
847 
848    Output Parameter:
849 .  result - location of occurance, PETSC_NULL if not found
850 
851    Notes:
852 
853      This version is different from the system version in that
854   it allows you to pass a read-only string into the function.
855 
856      This version also treats all characters etc. inside a double quote "
857    as a single token.
858 
859     Not for use in Fortran
860 
861    Level: intermediate
862 
863 
864 .seealso: PetscTokenCreate(), PetscTokenDestroy()
865 @*/
866 PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
867 {
868   char *ptr = a->current,token;
869 
870   PetscFunctionBegin;
871   *result = a->current;
872   if (ptr && !*ptr) {*result = 0;PetscFunctionReturn(0);}
873   token = a->token;
874   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
875   while (ptr) {
876     if (*ptr == token) {
877       *ptr++ = 0;
878       while (*ptr == a->token) ptr++;
879       a->current = ptr;
880       break;
881     }
882     if (!*ptr) {
883       a->current = 0;
884       break;
885     }
886     ptr++;
887   }
888   PetscFunctionReturn(0);
889 }
890 
891 #undef __FUNCT__
892 #define __FUNCT__ "PetscTokenCreate"
893 /*@C
894    PetscTokenCreate - Creates a PetscToken used to find tokens in a string
895 
896    Not Collective
897 
898    Input Parameters:
899 +  string - the string to look in
900 -  token - the character to look for
901 
902    Output Parameter:
903 .  a - pointer to token
904 
905    Notes:
906 
907      This version is different from the system version in that
908   it allows you to pass a read-only string into the function.
909 
910     Not for use in Fortran
911 
912    Level: intermediate
913 
914 .seealso: PetscTokenFind(), PetscTokenDestroy()
915 @*/
916 PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
917 {
918   PetscErrorCode ierr;
919 
920   PetscFunctionBegin;
921   ierr = PetscNew(struct _p_PetscToken,t);CHKERRQ(ierr);
922   ierr = PetscStrallocpy(a,&(*t)->array);CHKERRQ(ierr);
923   (*t)->current = (*t)->array;
924   (*t)->token   = b;
925   PetscFunctionReturn(0);
926 }
927 
928 #undef __FUNCT__
929 #define __FUNCT__ "PetscTokenDestroy"
930 /*@C
931    PetscTokenDestroy - Destroys a PetscToken
932 
933    Not Collective
934 
935    Input Parameters:
936 .  a - pointer to token
937 
938    Level: intermediate
939 
940    Notes:     Not for use in Fortran
941 
942 .seealso: PetscTokenCreate(), PetscTokenFind()
943 @*/
944 PetscErrorCode  PetscTokenDestroy(PetscToken *a)
945 {
946   PetscErrorCode ierr;
947 
948   PetscFunctionBegin;
949   if (!*a) PetscFunctionReturn(0);
950   ierr = PetscFree((*a)->array);CHKERRQ(ierr);
951   ierr = PetscFree(*a);CHKERRQ(ierr);
952   PetscFunctionReturn(0);
953 }
954 
955 
956 #undef __FUNCT__
957 #define __FUNCT__ "PetscGetPetscDir"
958 /*@C
959    PetscGetPetscDir - Gets the directory PETSc is installed in
960 
961    Not Collective
962 
963    Output Parameter:
964 .  dir - the directory
965 
966    Level: developer
967 
968    Notes: Not for use in Fortran
969 
970 @*/
971 PetscErrorCode  PetscGetPetscDir(const char *dir[])
972 {
973   PetscFunctionBegin;
974   *dir = PETSC_DIR;
975   PetscFunctionReturn(0);
976 }
977 
978 #undef __FUNCT__
979 #define __FUNCT__ "PetscStrreplace"
980 /*@C
981    PetscStrreplace - Replaces substrings in string with other substrings
982 
983    Not Collective
984 
985    Input Parameters:
986 +   comm - MPI_Comm of processors that are processing the string
987 .   aa - the string to look in
988 .   b - the resulting copy of a with replaced strings (b can be the same as a)
989 -   len - the length of b
990 
991    Notes:
992       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
993       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
994       as well as any environmental variables.
995 
996       PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
997       PETSc was built with and do not use environmental variables.
998 
999       Not for use in Fortran
1000 
1001    Level: intermediate
1002 
1003 @*/
1004 PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
1005 {
1006   PetscErrorCode ierr;
1007   int            i = 0;
1008   size_t         l,l1,l2,l3;
1009   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
1010   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
1011   const char     *r[] = {0,0,0,0,0,0,0,0,0};
1012   PetscBool      flag;
1013 
1014   PetscFunctionBegin;
1015   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
1016   if (aa == b) {
1017     ierr    = PetscStrallocpy(aa,(char **)&a);CHKERRQ(ierr);
1018   }
1019   ierr = PetscMalloc(len*sizeof(char*),&work);CHKERRQ(ierr);
1020 
1021   /* get values for replaced variables */
1022   ierr = PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);CHKERRQ(ierr);
1023   ierr = PetscStrallocpy(PETSC_DIR,(char**)&r[1]);CHKERRQ(ierr);
1024   ierr = PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);CHKERRQ(ierr);
1025   ierr = PetscMalloc(256*sizeof(char),&r[3]);CHKERRQ(ierr);
1026   ierr = PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[4]);CHKERRQ(ierr);
1027   ierr = PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[5]);CHKERRQ(ierr);
1028   ierr = PetscMalloc(256*sizeof(char),&r[6]);CHKERRQ(ierr);
1029   ierr = PetscMalloc(256*sizeof(char),&r[7]);CHKERRQ(ierr);
1030   ierr = PetscGetDisplay((char*)r[3],256);CHKERRQ(ierr);
1031   ierr = PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
1032   ierr = PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
1033   ierr = PetscGetUserName((char*)r[6],256);CHKERRQ(ierr);
1034   ierr = PetscGetHostName((char*)r[7],256);CHKERRQ(ierr);
1035 
1036   /* replace that are in environment */
1037   ierr = PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);CHKERRQ(ierr);
1038   if (flag) {
1039     ierr = PetscStrallocpy(env,(char**)&r[2]);CHKERRQ(ierr);
1040   }
1041 
1042   /* replace the requested strings */
1043   ierr = PetscStrncpy(b,a,len);CHKERRQ(ierr);
1044   while (s[i]) {
1045     ierr = PetscStrlen(s[i],&l);CHKERRQ(ierr);
1046     ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
1047     while (par) {
1048       *par  =  0;
1049       par  += l;
1050 
1051       ierr = PetscStrlen(b,&l1);CHKERRQ(ierr);
1052       ierr = PetscStrlen(r[i],&l2);CHKERRQ(ierr);
1053       ierr = PetscStrlen(par,&l3);CHKERRQ(ierr);
1054       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
1055       ierr  = PetscStrcpy(work,b);CHKERRQ(ierr);
1056       ierr  = PetscStrcat(work,r[i]);CHKERRQ(ierr);
1057       ierr  = PetscStrcat(work,par);CHKERRQ(ierr);
1058       ierr  = PetscStrncpy(b,work,len);CHKERRQ(ierr);
1059       ierr  = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
1060     }
1061     i++;
1062   }
1063   i = 0;
1064   while (r[i]) {
1065     tfree = (char*)r[i];
1066     ierr = PetscFree(tfree);CHKERRQ(ierr);
1067     i++;
1068   }
1069 
1070   /* look for any other ${xxx} strings to replace from environmental variables */
1071   ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
1072   while (par) {
1073     *par = 0;
1074     par += 2;
1075     ierr  = PetscStrcpy(work,b);CHKERRQ(ierr);
1076     ierr = PetscStrstr(par,"}",&epar);CHKERRQ(ierr);
1077     *epar = 0;
1078     epar += 1;
1079     ierr = PetscOptionsGetenv(comm,par,env,256,&flag);CHKERRQ(ierr);
1080     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
1081     ierr = PetscStrcat(work,env);CHKERRQ(ierr);
1082     ierr = PetscStrcat(work,epar);CHKERRQ(ierr);
1083     ierr = PetscStrcpy(b,work);CHKERRQ(ierr);
1084     ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
1085   }
1086   ierr = PetscFree(work);CHKERRQ(ierr);
1087   if (aa == b) {
1088     ierr = PetscFree(a);CHKERRQ(ierr);
1089   }
1090   PetscFunctionReturn(0);
1091 }
1092 
1093 
1094