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