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