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