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