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