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