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