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 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 ierr = PetscStrlen(t,&len);CHKERRQ(ierr); 470 strncat(s,t,n - len); 471 s[n-1] = 0; 472 PetscFunctionReturn(0); 473 } 474 475 /* 476 Only to be used with PetscCheck__FUNCT__()! 477 478 */ 479 void PetscStrcmpNoError(const char a[],const char b[],PetscBool *flg) 480 { 481 int c; 482 483 if (!a && !b) *flg = PETSC_TRUE; 484 else if (!a || !b) *flg = PETSC_FALSE; 485 else { 486 c = strcmp(a,b); 487 if (c) *flg = PETSC_FALSE; 488 else *flg = PETSC_TRUE; 489 } 490 } 491 492 /*@C 493 PetscStrcmp - Compares two strings, 494 495 Not Collective 496 497 Input Parameters: 498 + a - pointer to string first string 499 - b - pointer to second string 500 501 Output Parameter: 502 . flg - PETSC_TRUE if the two strings are equal 503 504 Level: intermediate 505 506 Notes: 507 Not for use in Fortran 508 509 .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp() 510 511 @*/ 512 PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg) 513 { 514 int c; 515 516 PetscFunctionBegin; 517 if (!a && !b) *flg = PETSC_TRUE; 518 else if (!a || !b) *flg = PETSC_FALSE; 519 else { 520 c = strcmp(a,b); 521 if (c) *flg = PETSC_FALSE; 522 else *flg = PETSC_TRUE; 523 } 524 PetscFunctionReturn(0); 525 } 526 527 /*@C 528 PetscStrgrt - If first string is greater than the second 529 530 Not Collective 531 532 Input Parameters: 533 + a - pointer to first string 534 - b - pointer to second string 535 536 Output Parameter: 537 . flg - if the first string is greater 538 539 Notes: 540 Null arguments are ok, a null string is considered smaller than 541 all others 542 543 Not for use in Fortran 544 545 Level: intermediate 546 547 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp() 548 549 @*/ 550 PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t) 551 { 552 int c; 553 554 PetscFunctionBegin; 555 if (!a && !b) *t = PETSC_FALSE; 556 else if (a && !b) *t = PETSC_TRUE; 557 else if (!a && b) *t = PETSC_FALSE; 558 else { 559 c = strcmp(a,b); 560 if (c > 0) *t = PETSC_TRUE; 561 else *t = PETSC_FALSE; 562 } 563 PetscFunctionReturn(0); 564 } 565 566 /*@C 567 PetscStrcasecmp - Returns true if the two strings are the same 568 except possibly for case. 569 570 Not Collective 571 572 Input Parameters: 573 + a - pointer to first string 574 - b - pointer to second string 575 576 Output Parameter: 577 . flg - if the two strings are the same 578 579 Notes: 580 Null arguments are ok 581 582 Not for use in Fortran 583 584 Level: intermediate 585 586 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt() 587 588 @*/ 589 PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t) 590 { 591 int c; 592 593 PetscFunctionBegin; 594 if (!a && !b) c = 0; 595 else if (!a || !b) c = 1; 596 #if defined(PETSC_HAVE_STRCASECMP) 597 else c = strcasecmp(a,b); 598 #elif defined(PETSC_HAVE_STRICMP) 599 else c = stricmp(a,b); 600 #else 601 else { 602 char *aa,*bb; 603 PetscErrorCode ierr; 604 ierr = PetscStrallocpy(a,&aa);CHKERRQ(ierr); 605 ierr = PetscStrallocpy(b,&bb);CHKERRQ(ierr); 606 ierr = PetscStrtolower(aa);CHKERRQ(ierr); 607 ierr = PetscStrtolower(bb);CHKERRQ(ierr); 608 ierr = PetscStrcmp(aa,bb,t);CHKERRQ(ierr); 609 ierr = PetscFree(aa);CHKERRQ(ierr); 610 ierr = PetscFree(bb);CHKERRQ(ierr); 611 PetscFunctionReturn(0); 612 } 613 #endif 614 if (!c) *t = PETSC_TRUE; 615 else *t = PETSC_FALSE; 616 PetscFunctionReturn(0); 617 } 618 619 620 621 /*@C 622 PetscStrncmp - Compares two strings, up to a certain length 623 624 Not Collective 625 626 Input Parameters: 627 + a - pointer to first string 628 . b - pointer to second string 629 - n - length to compare up to 630 631 Output Parameter: 632 . t - if the two strings are equal 633 634 Level: intermediate 635 636 Notes: 637 Not for use in Fortran 638 639 .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp() 640 641 @*/ 642 PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t) 643 { 644 int c; 645 646 PetscFunctionBegin; 647 c = strncmp(a,b,n); 648 if (!c) *t = PETSC_TRUE; 649 else *t = PETSC_FALSE; 650 PetscFunctionReturn(0); 651 } 652 653 /*@C 654 PetscStrchr - Locates first occurance of a character in a string 655 656 Not Collective 657 658 Input Parameters: 659 + a - pointer to string 660 - b - character 661 662 Output Parameter: 663 . c - location of occurance, NULL if not found 664 665 Level: intermediate 666 667 Notes: 668 Not for use in Fortran 669 670 @*/ 671 PetscErrorCode PetscStrchr(const char a[],char b,char *c[]) 672 { 673 PetscFunctionBegin; 674 *c = (char*)strchr(a,b); 675 PetscFunctionReturn(0); 676 } 677 678 /*@C 679 PetscStrrchr - Locates one location past the last occurance of a character in a string, 680 if the character is not found then returns entire string 681 682 Not Collective 683 684 Input Parameters: 685 + a - pointer to string 686 - b - character 687 688 Output Parameter: 689 . tmp - location of occurance, a if not found 690 691 Level: intermediate 692 693 Notes: 694 Not for use in Fortran 695 696 @*/ 697 PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[]) 698 { 699 PetscFunctionBegin; 700 *tmp = (char*)strrchr(a,b); 701 if (!*tmp) *tmp = (char*)a; 702 else *tmp = *tmp + 1; 703 PetscFunctionReturn(0); 704 } 705 706 /*@C 707 PetscStrtolower - Converts string to lower 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 PetscStrtolower(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 PetscStrtoupper - Converts string to upper case 732 733 Not Collective 734 735 Input Parameters: 736 . a - pointer to string 737 738 Level: intermediate 739 740 Notes: 741 Not for use in Fortran 742 743 @*/ 744 PetscErrorCode PetscStrtoupper(char a[]) 745 { 746 PetscFunctionBegin; 747 while (*a) { 748 if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a'; 749 a++; 750 } 751 PetscFunctionReturn(0); 752 } 753 754 /*@C 755 PetscStrendswith - Determines if a string ends with a certain string 756 757 Not Collective 758 759 Input Parameters: 760 + a - pointer to string 761 - b - string to endwith 762 763 Output Parameter: 764 . flg - PETSC_TRUE or PETSC_FALSE 765 766 Notes: 767 Not for use in Fortran 768 769 Level: intermediate 770 771 @*/ 772 PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg) 773 { 774 char *test; 775 PetscErrorCode ierr; 776 size_t na,nb; 777 778 PetscFunctionBegin; 779 *flg = PETSC_FALSE; 780 ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr); 781 if (test) { 782 ierr = PetscStrlen(a,&na);CHKERRQ(ierr); 783 ierr = PetscStrlen(b,&nb);CHKERRQ(ierr); 784 if (a+na-nb == test) *flg = PETSC_TRUE; 785 } 786 PetscFunctionReturn(0); 787 } 788 789 /*@C 790 PetscStrbeginswith - Determines if a string begins with a certain string 791 792 Not Collective 793 794 Input Parameters: 795 + a - pointer to string 796 - b - string to begin with 797 798 Output Parameter: 799 . flg - PETSC_TRUE or PETSC_FALSE 800 801 Notes: 802 Not for use in Fortran 803 804 Level: intermediate 805 806 .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(), 807 PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp() 808 809 @*/ 810 PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg) 811 { 812 char *test; 813 PetscErrorCode ierr; 814 815 PetscFunctionBegin; 816 *flg = PETSC_FALSE; 817 ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr); 818 if (test && (test == a)) *flg = PETSC_TRUE; 819 PetscFunctionReturn(0); 820 } 821 822 823 /*@C 824 PetscStrendswithwhich - Determines if a string ends with one of several possible strings 825 826 Not Collective 827 828 Input Parameters: 829 + a - pointer to string 830 - bs - strings to endwith (last entry must be null) 831 832 Output Parameter: 833 . cnt - the index of the string it ends with or 1+the last possible index 834 835 Notes: 836 Not for use in Fortran 837 838 Level: intermediate 839 840 @*/ 841 PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt) 842 { 843 PetscBool flg; 844 PetscErrorCode ierr; 845 846 PetscFunctionBegin; 847 *cnt = 0; 848 while (bs[*cnt]) { 849 ierr = PetscStrendswith(a,bs[*cnt],&flg);CHKERRQ(ierr); 850 if (flg) PetscFunctionReturn(0); 851 *cnt += 1; 852 } 853 PetscFunctionReturn(0); 854 } 855 856 /*@C 857 PetscStrrstr - Locates last occurance of string in another string 858 859 Not Collective 860 861 Input Parameters: 862 + a - pointer to string 863 - b - string to find 864 865 Output Parameter: 866 . tmp - location of occurance 867 868 Notes: 869 Not for use in Fortran 870 871 Level: intermediate 872 873 @*/ 874 PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[]) 875 { 876 const char *stmp = a, *ltmp = 0; 877 878 PetscFunctionBegin; 879 while (stmp) { 880 stmp = (char*)strstr(stmp,b); 881 if (stmp) {ltmp = stmp;stmp++;} 882 } 883 *tmp = (char*)ltmp; 884 PetscFunctionReturn(0); 885 } 886 887 /*@C 888 PetscStrstr - Locates first occurance of string in another string 889 890 Not Collective 891 892 Input Parameters: 893 + haystack - string to search 894 - needle - string to find 895 896 Output Parameter: 897 . tmp - location of occurance, is a NULL if the string is not found 898 899 Notes: 900 Not for use in Fortran 901 902 Level: intermediate 903 904 @*/ 905 PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[]) 906 { 907 PetscFunctionBegin; 908 *tmp = (char*)strstr(haystack,needle); 909 PetscFunctionReturn(0); 910 } 911 912 struct _p_PetscToken {char token;char *array;char *current;}; 913 914 /*@C 915 PetscTokenFind - Locates next "token" in a string 916 917 Not Collective 918 919 Input Parameters: 920 . a - pointer to token 921 922 Output Parameter: 923 . result - location of occurance, NULL if not found 924 925 Notes: 926 927 This version is different from the system version in that 928 it allows you to pass a read-only string into the function. 929 930 This version also treats all characters etc. inside a double quote " 931 as a single token. 932 933 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 934 second will return a null terminated y 935 936 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 937 938 Not for use in Fortran 939 940 Level: intermediate 941 942 943 .seealso: PetscTokenCreate(), PetscTokenDestroy() 944 @*/ 945 PetscErrorCode PetscTokenFind(PetscToken a,char *result[]) 946 { 947 char *ptr = a->current,token; 948 949 PetscFunctionBegin; 950 *result = a->current; 951 if (ptr && !*ptr) {*result = 0;PetscFunctionReturn(0);} 952 token = a->token; 953 if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;} 954 while (ptr) { 955 if (*ptr == token) { 956 *ptr++ = 0; 957 while (*ptr == a->token) ptr++; 958 a->current = ptr; 959 break; 960 } 961 if (!*ptr) { 962 a->current = 0; 963 break; 964 } 965 ptr++; 966 } 967 PetscFunctionReturn(0); 968 } 969 970 /*@C 971 PetscTokenCreate - Creates a PetscToken used to find tokens in a string 972 973 Not Collective 974 975 Input Parameters: 976 + string - the string to look in 977 - b - the separator character 978 979 Output Parameter: 980 . t- the token object 981 982 Notes: 983 984 This version is different from the system version in that 985 it allows you to pass a read-only string into the function. 986 987 Not for use in Fortran 988 989 Level: intermediate 990 991 .seealso: PetscTokenFind(), PetscTokenDestroy() 992 @*/ 993 PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t) 994 { 995 PetscErrorCode ierr; 996 997 PetscFunctionBegin; 998 ierr = PetscNew(t);CHKERRQ(ierr); 999 ierr = PetscStrallocpy(a,&(*t)->array);CHKERRQ(ierr); 1000 1001 (*t)->current = (*t)->array; 1002 (*t)->token = b; 1003 PetscFunctionReturn(0); 1004 } 1005 1006 /*@C 1007 PetscTokenDestroy - Destroys a PetscToken 1008 1009 Not Collective 1010 1011 Input Parameters: 1012 . a - pointer to token 1013 1014 Level: intermediate 1015 1016 Notes: 1017 Not for use in Fortran 1018 1019 .seealso: PetscTokenCreate(), PetscTokenFind() 1020 @*/ 1021 PetscErrorCode PetscTokenDestroy(PetscToken *a) 1022 { 1023 PetscErrorCode ierr; 1024 1025 PetscFunctionBegin; 1026 if (!*a) PetscFunctionReturn(0); 1027 ierr = PetscFree((*a)->array);CHKERRQ(ierr); 1028 ierr = PetscFree(*a);CHKERRQ(ierr); 1029 PetscFunctionReturn(0); 1030 } 1031 1032 /*@C 1033 PetscStrInList - search string in character-delimited list 1034 1035 Not Collective 1036 1037 Input Parameters: 1038 + str - the string to look for 1039 . list - the list to search in 1040 - sep - the separator character 1041 1042 Output Parameter: 1043 . found - whether str is in list 1044 1045 Level: intermediate 1046 1047 Notes: 1048 Not for use in Fortran 1049 1050 .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp() 1051 @*/ 1052 PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found) 1053 { 1054 PetscToken token; 1055 char *item; 1056 PetscErrorCode ierr; 1057 1058 PetscFunctionBegin; 1059 *found = PETSC_FALSE; 1060 ierr = PetscTokenCreate(list,sep,&token);CHKERRQ(ierr); 1061 ierr = PetscTokenFind(token,&item);CHKERRQ(ierr); 1062 while (item) { 1063 ierr = PetscStrcmp(str,item,found);CHKERRQ(ierr); 1064 if (*found) break; 1065 ierr = PetscTokenFind(token,&item);CHKERRQ(ierr); 1066 } 1067 ierr = PetscTokenDestroy(&token);CHKERRQ(ierr); 1068 PetscFunctionReturn(0); 1069 } 1070 1071 /*@C 1072 PetscGetPetscDir - Gets the directory PETSc is installed in 1073 1074 Not Collective 1075 1076 Output Parameter: 1077 . dir - the directory 1078 1079 Level: developer 1080 1081 Notes: 1082 Not for use in Fortran 1083 1084 @*/ 1085 PetscErrorCode PetscGetPetscDir(const char *dir[]) 1086 { 1087 PetscFunctionBegin; 1088 *dir = PETSC_DIR; 1089 PetscFunctionReturn(0); 1090 } 1091 1092 /*@C 1093 PetscStrreplace - Replaces substrings in string with other substrings 1094 1095 Not Collective 1096 1097 Input Parameters: 1098 + comm - MPI_Comm of processors that are processing the string 1099 . aa - the string to look in 1100 . b - the resulting copy of a with replaced strings (b can be the same as a) 1101 - len - the length of b 1102 1103 Notes: 1104 Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY}, 1105 ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values 1106 as well as any environmental variables. 1107 1108 PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what 1109 PETSc was built with and do not use environmental variables. 1110 1111 Not for use in Fortran 1112 1113 Level: intermediate 1114 1115 @*/ 1116 PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len) 1117 { 1118 PetscErrorCode ierr; 1119 int i = 0; 1120 size_t l,l1,l2,l3; 1121 char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa; 1122 const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0}; 1123 char *r[] = {0,0,0,0,0,0,0,0,0}; 1124 PetscBool flag; 1125 1126 PetscFunctionBegin; 1127 if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull"); 1128 if (aa == b) { 1129 ierr = PetscStrallocpy(aa,(char**)&a);CHKERRQ(ierr); 1130 } 1131 ierr = PetscMalloc1(len,&work);CHKERRQ(ierr); 1132 1133 /* get values for replaced variables */ 1134 ierr = PetscStrallocpy(PETSC_ARCH,&r[0]);CHKERRQ(ierr); 1135 ierr = PetscStrallocpy(PETSC_DIR,&r[1]);CHKERRQ(ierr); 1136 ierr = PetscStrallocpy(PETSC_LIB_DIR,&r[2]);CHKERRQ(ierr); 1137 ierr = PetscMalloc1(256,&r[3]);CHKERRQ(ierr); 1138 ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);CHKERRQ(ierr); 1139 ierr = PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);CHKERRQ(ierr); 1140 ierr = PetscMalloc1(256,&r[6]);CHKERRQ(ierr); 1141 ierr = PetscMalloc1(256,&r[7]);CHKERRQ(ierr); 1142 ierr = PetscGetDisplay(r[3],256);CHKERRQ(ierr); 1143 ierr = PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);CHKERRQ(ierr); 1144 ierr = PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);CHKERRQ(ierr); 1145 ierr = PetscGetUserName(r[6],256);CHKERRQ(ierr); 1146 ierr = PetscGetHostName(r[7],256);CHKERRQ(ierr); 1147 1148 /* replace that are in environment */ 1149 ierr = PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);CHKERRQ(ierr); 1150 if (flag) { 1151 ierr = PetscFree(r[2]);CHKERRQ(ierr); 1152 ierr = PetscStrallocpy(env,&r[2]);CHKERRQ(ierr); 1153 } 1154 1155 /* replace the requested strings */ 1156 ierr = PetscStrncpy(b,a,len);CHKERRQ(ierr); 1157 while (s[i]) { 1158 ierr = PetscStrlen(s[i],&l);CHKERRQ(ierr); 1159 ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr); 1160 while (par) { 1161 *par = 0; 1162 par += l; 1163 1164 ierr = PetscStrlen(b,&l1);CHKERRQ(ierr); 1165 ierr = PetscStrlen(r[i],&l2);CHKERRQ(ierr); 1166 ierr = PetscStrlen(par,&l3);CHKERRQ(ierr); 1167 if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values"); 1168 ierr = PetscStrcpy(work,b);CHKERRQ(ierr); 1169 ierr = PetscStrcat(work,r[i]);CHKERRQ(ierr); 1170 ierr = PetscStrcat(work,par);CHKERRQ(ierr); 1171 ierr = PetscStrncpy(b,work,len);CHKERRQ(ierr); 1172 ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr); 1173 } 1174 i++; 1175 } 1176 i = 0; 1177 while (r[i]) { 1178 tfree = (char*)r[i]; 1179 ierr = PetscFree(tfree);CHKERRQ(ierr); 1180 i++; 1181 } 1182 1183 /* look for any other ${xxx} strings to replace from environmental variables */ 1184 ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr); 1185 while (par) { 1186 *par = 0; 1187 par += 2; 1188 ierr = PetscStrcpy(work,b);CHKERRQ(ierr); 1189 ierr = PetscStrstr(par,"}",&epar);CHKERRQ(ierr); 1190 *epar = 0; 1191 epar += 1; 1192 ierr = PetscOptionsGetenv(comm,par,env,256,&flag);CHKERRQ(ierr); 1193 if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par); 1194 ierr = PetscStrcat(work,env);CHKERRQ(ierr); 1195 ierr = PetscStrcat(work,epar);CHKERRQ(ierr); 1196 ierr = PetscStrcpy(b,work);CHKERRQ(ierr); 1197 ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr); 1198 } 1199 ierr = PetscFree(work);CHKERRQ(ierr); 1200 if (aa == b) { 1201 ierr = PetscFree(a);CHKERRQ(ierr); 1202 } 1203 PetscFunctionReturn(0); 1204 } 1205 1206 /*@C 1207 PetscEListFind - searches list of strings for given string, using case insensitive matching 1208 1209 Not Collective 1210 1211 Input Parameters: 1212 + n - number of strings in 1213 . list - list of strings to search 1214 - str - string to look for, empty string "" accepts default (first entry in list) 1215 1216 Output Parameters: 1217 + value - index of matching string (if found) 1218 - found - boolean indicating whether string was found (can be NULL) 1219 1220 Notes: 1221 Not for use in Fortran 1222 1223 Level: advanced 1224 @*/ 1225 PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found) 1226 { 1227 PetscErrorCode ierr; 1228 PetscBool matched; 1229 PetscInt i; 1230 1231 PetscFunctionBegin; 1232 if (found) *found = PETSC_FALSE; 1233 for (i=0; i<n; i++) { 1234 ierr = PetscStrcasecmp(str,list[i],&matched);CHKERRQ(ierr); 1235 if (matched || !str[0]) { 1236 if (found) *found = PETSC_TRUE; 1237 *value = i; 1238 break; 1239 } 1240 } 1241 PetscFunctionReturn(0); 1242 } 1243 1244 /*@C 1245 PetscEnumFind - searches enum list of strings for given string, using case insensitive matching 1246 1247 Not Collective 1248 1249 Input Parameters: 1250 + enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL 1251 - str - string to look for 1252 1253 Output Parameters: 1254 + value - index of matching string (if found) 1255 - found - boolean indicating whether string was found (can be NULL) 1256 1257 Notes: 1258 Not for use in Fortran 1259 1260 Level: advanced 1261 @*/ 1262 PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found) 1263 { 1264 PetscErrorCode ierr; 1265 PetscInt n = 0,evalue; 1266 PetscBool efound; 1267 1268 PetscFunctionBegin; 1269 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"); 1270 if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix"); 1271 n -= 3; /* drop enum name, prefix, and null termination */ 1272 ierr = PetscEListFind(n,enumlist,str,&evalue,&efound);CHKERRQ(ierr); 1273 if (efound) *value = (PetscEnum)evalue; 1274 if (found) *found = efound; 1275 PetscFunctionReturn(0); 1276 } 1277