xref: /petsc/src/sys/utils/str.c (revision 84df9cb40eca90ea9b18a456fab7a4ecc7f6c1a4)
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 - PETSC_TRUE 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 #undef __FUNCT__
569 #define __FUNCT__ "PetscStrendswith"
570 /*@C
571    PetscStrendswith - Determines if a string ends with a certain string
572 
573    Not Collective
574 
575    Input Parameters:
576 +  a - pointer to string
577 -  b - string to endwith
578 
579    Output Parameter:
580 .  flg - PETSC_TRUE or PETSC_FALSE
581 
582    Notes:     Not for use in Fortran
583 
584    Level: intermediate
585 
586 @*/
587 PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
588 {
589   char           *test;
590   PetscErrorCode ierr;
591   size_t         na,nb;
592 
593   PetscFunctionBegin;
594   *flg = PETSC_FALSE;
595   ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr);
596   if (test) {
597     ierr = PetscStrlen(a,&na);CHKERRQ(ierr);
598     ierr = PetscStrlen(b,&nb);CHKERRQ(ierr);
599     if (a+na-nb == test) *flg = PETSC_TRUE;
600   }
601   PetscFunctionReturn(0);
602 }
603 
604 #undef __FUNCT__
605 #define __FUNCT__ "PetscStrendswithwhich"
606 /*@C
607    PetscStrendswithwhich - Determines if a string ends with one of several possible strings
608 
609    Not Collective
610 
611    Input Parameters:
612 +  a - pointer to string
613 -  bs - strings to endwith (last entry must be null)
614 
615    Output Parameter:
616 .  cnt - the index of the string it ends with or 1+the last possible index
617 
618    Notes:     Not for use in Fortran
619 
620    Level: intermediate
621 
622 @*/
623 PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
624 {
625   PetscBool      flg;
626   PetscErrorCode ierr;
627 
628   PetscFunctionBegin;
629   *cnt = 0;
630   while (bs[*cnt]) {
631     ierr = PetscStrendswith(a,bs[*cnt],&flg);CHKERRQ(ierr);
632     if (flg) PetscFunctionReturn(0);
633     *cnt += 1;
634   }
635   PetscFunctionReturn(0);
636 }
637 
638 #undef __FUNCT__
639 #define __FUNCT__ "PetscStrrstr"
640 /*@C
641    PetscStrrstr - Locates last occurance of string in another string
642 
643    Not Collective
644 
645    Input Parameters:
646 +  a - pointer to string
647 -  b - string to find
648 
649    Output Parameter:
650 .  tmp - location of occurance
651 
652    Notes:     Not for use in Fortran
653 
654    Level: intermediate
655 
656 @*/
657 PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
658 {
659   const char *stmp = a, *ltmp = 0;
660 
661   PetscFunctionBegin;
662   while (stmp) {
663     stmp = (char *)strstr(stmp,b);
664     if (stmp) {ltmp = stmp;stmp++;}
665   }
666   *tmp = (char *)ltmp;
667   PetscFunctionReturn(0);
668 }
669 
670 #undef __FUNCT__
671 #define __FUNCT__ "PetscStrstr"
672 /*@C
673    PetscStrstr - Locates first occurance of string in another string
674 
675    Not Collective
676 
677    Input Parameters:
678 +  a - pointer to string
679 -  b - string to find
680 
681    Output Parameter:
682 .  tmp - location of occurance, is a PETSC_NULL if the string is not found
683 
684    Notes: Not for use in Fortran
685 
686    Level: intermediate
687 
688 @*/
689 PetscErrorCode  PetscStrstr(const char a[],const char b[],char *tmp[])
690 {
691   PetscFunctionBegin;
692   *tmp = (char *)strstr(a,b);
693   PetscFunctionReturn(0);
694 }
695 
696 struct _p_PetscToken {char token;char *array;char *current;};
697 
698 #undef __FUNCT__
699 #define __FUNCT__ "PetscTokenFind"
700 /*@C
701    PetscTokenFind - Locates next "token" in a string
702 
703    Not Collective
704 
705    Input Parameters:
706 .  a - pointer to token
707 
708    Output Parameter:
709 .  result - location of occurance, PETSC_NULL if not found
710 
711    Notes:
712 
713      This version is different from the system version in that
714   it allows you to pass a read-only string into the function.
715 
716      This version also treats all characters etc. inside a double quote "
717    as a single token.
718 
719     Not for use in Fortran
720 
721    Level: intermediate
722 
723 
724 .seealso: PetscTokenCreate(), PetscTokenDestroy()
725 @*/
726 PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
727 {
728   char *ptr = a->current,token;
729 
730   PetscFunctionBegin;
731   *result = a->current;
732   if (ptr && !*ptr) {*result = 0;PetscFunctionReturn(0);}
733   token = a->token;
734   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
735   while (ptr) {
736     if (*ptr == token) {
737       *ptr++ = 0;
738       while (*ptr == a->token) ptr++;
739       a->current = ptr;
740       break;
741     }
742     if (!*ptr) {
743       a->current = 0;
744       break;
745     }
746     ptr++;
747   }
748   PetscFunctionReturn(0);
749 }
750 
751 #undef __FUNCT__
752 #define __FUNCT__ "PetscTokenCreate"
753 /*@C
754    PetscTokenCreate - Creates a PetscToken used to find tokens in a string
755 
756    Not Collective
757 
758    Input Parameters:
759 +  string - the string to look in
760 -  token - the character to look for
761 
762    Output Parameter:
763 .  a - pointer to token
764 
765    Notes:
766 
767      This version is different from the system version in that
768   it allows you to pass a read-only string into the function.
769 
770     Not for use in Fortran
771 
772    Level: intermediate
773 
774 .seealso: PetscTokenFind(), PetscTokenDestroy()
775 @*/
776 PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
777 {
778   PetscErrorCode ierr;
779 
780   PetscFunctionBegin;
781   ierr = PetscNew(struct _p_PetscToken,t);CHKERRQ(ierr);
782   ierr = PetscStrallocpy(a,&(*t)->array);CHKERRQ(ierr);
783   (*t)->current = (*t)->array;
784   (*t)->token   = b;
785   PetscFunctionReturn(0);
786 }
787 
788 #undef __FUNCT__
789 #define __FUNCT__ "PetscTokenDestroy"
790 /*@C
791    PetscTokenDestroy - Destroys a PetscToken
792 
793    Not Collective
794 
795    Input Parameters:
796 .  a - pointer to token
797 
798    Level: intermediate
799 
800    Notes:     Not for use in Fortran
801 
802 .seealso: PetscTokenCreate(), PetscTokenFind()
803 @*/
804 PetscErrorCode  PetscTokenDestroy(PetscToken *a)
805 {
806   PetscErrorCode ierr;
807 
808   PetscFunctionBegin;
809   if (!*a) PetscFunctionReturn(0);
810   ierr = PetscFree((*a)->array);CHKERRQ(ierr);
811   ierr = PetscFree(*a);CHKERRQ(ierr);
812   PetscFunctionReturn(0);
813 }
814 
815 
816 #undef __FUNCT__
817 #define __FUNCT__ "PetscGetPetscDir"
818 /*@C
819    PetscGetPetscDir - Gets the directory PETSc is installed in
820 
821    Not Collective
822 
823    Output Parameter:
824 .  dir - the directory
825 
826    Level: developer
827 
828    Notes: Not for use in Fortran
829 
830 @*/
831 PetscErrorCode  PetscGetPetscDir(const char *dir[])
832 {
833   PetscFunctionBegin;
834   *dir = PETSC_DIR;
835   PetscFunctionReturn(0);
836 }
837 
838 #undef __FUNCT__
839 #define __FUNCT__ "PetscStrreplace"
840 /*@C
841    PetscStrreplace - Replaces substrings in string with other substrings
842 
843    Not Collective
844 
845    Input Parameters:
846 +   comm - MPI_Comm of processors that are processing the string
847 .   aa - the string to look in
848 .   b - the resulting copy of a with replaced strings (b can be the same as a)
849 -   len - the length of b
850 
851    Notes:
852       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
853       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
854       as well as any environmental variables.
855 
856       PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
857       PETSc was built with and do not use environmental variables.
858 
859       Not for use in Fortran
860 
861    Level: intermediate
862 
863 @*/
864 PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
865 {
866   PetscErrorCode ierr;
867   int            i = 0;
868   size_t         l,l1,l2,l3;
869   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
870   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0};
871   const char     *r[] = {0,0,0,0,0,0,0,0,0};
872   PetscBool      flag;
873 
874   PetscFunctionBegin;
875   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
876   if (aa == b) {
877     ierr    = PetscStrallocpy(aa,(char **)&a);CHKERRQ(ierr);
878   }
879   ierr = PetscMalloc(len*sizeof(char*),&work);CHKERRQ(ierr);
880 
881   /* get values for replaced variables */
882   ierr = PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);CHKERRQ(ierr);
883   ierr = PetscStrallocpy(PETSC_DIR,(char**)&r[1]);CHKERRQ(ierr);
884   ierr = PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);CHKERRQ(ierr);
885   ierr = PetscMalloc(256*sizeof(char),&r[3]);CHKERRQ(ierr);
886   ierr = PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[4]);CHKERRQ(ierr);
887   ierr = PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[5]);CHKERRQ(ierr);
888   ierr = PetscMalloc(256*sizeof(char),&r[6]);CHKERRQ(ierr);
889   ierr = PetscMalloc(256*sizeof(char),&r[7]);CHKERRQ(ierr);
890   ierr = PetscGetDisplay((char*)r[3],256);CHKERRQ(ierr);
891   ierr = PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
892   ierr = PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
893   ierr = PetscGetUserName((char*)r[6],256);CHKERRQ(ierr);
894   ierr = PetscGetHostName((char*)r[7],256);CHKERRQ(ierr);
895 
896   /* replace that are in environment */
897   ierr = PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);CHKERRQ(ierr);
898   if (flag) {
899     ierr = PetscStrallocpy(env,(char**)&r[2]);CHKERRQ(ierr);
900   }
901 
902   /* replace the requested strings */
903   ierr = PetscStrncpy(b,a,len);CHKERRQ(ierr);
904   while (s[i]) {
905     ierr = PetscStrlen(s[i],&l);CHKERRQ(ierr);
906     ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
907     while (par) {
908       *par  =  0;
909       par  += l;
910 
911       ierr = PetscStrlen(b,&l1);CHKERRQ(ierr);
912       ierr = PetscStrlen(r[i],&l2);CHKERRQ(ierr);
913       ierr = PetscStrlen(par,&l3);CHKERRQ(ierr);
914       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
915       ierr  = PetscStrcpy(work,b);CHKERRQ(ierr);
916       ierr  = PetscStrcat(work,r[i]);CHKERRQ(ierr);
917       ierr  = PetscStrcat(work,par);CHKERRQ(ierr);
918       ierr  = PetscStrncpy(b,work,len);CHKERRQ(ierr);
919       ierr  = PetscStrstr(b,s[i],&par);CHKERRQ(ierr);
920     }
921     i++;
922   }
923   i = 0;
924   while (r[i]) {
925     tfree = (char*)r[i];
926     ierr = PetscFree(tfree);CHKERRQ(ierr);
927     i++;
928   }
929 
930   /* look for any other ${xxx} strings to replace from environmental variables */
931   ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
932   while (par) {
933     *par = 0;
934     par += 2;
935     ierr  = PetscStrcpy(work,b);CHKERRQ(ierr);
936     ierr = PetscStrstr(par,"}",&epar);CHKERRQ(ierr);
937     *epar = 0;
938     epar += 1;
939     ierr = PetscOptionsGetenv(comm,par,env,256,&flag);CHKERRQ(ierr);
940     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
941     ierr = PetscStrcat(work,env);CHKERRQ(ierr);
942     ierr = PetscStrcat(work,epar);CHKERRQ(ierr);
943     ierr = PetscStrcpy(b,work);CHKERRQ(ierr);
944     ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr);
945   }
946   ierr = PetscFree(work);CHKERRQ(ierr);
947   if (aa == b) {
948     ierr = PetscFree(a);CHKERRQ(ierr);
949   }
950   PetscFunctionReturn(0);
951 }
952 
953 
954