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