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