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