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> 11 #endif 12 #if defined(PETSC_HAVE_STRINGS_H) 13 #include <strings.h> 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 = PetscMalloc((1+len)*sizeof(char),&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 = PetscMalloc((n+1)*sizeof(char**),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__ "PetscStrcmp" 393 /*@C 394 PetscStrcmp - Compares two strings, 395 396 Not Collective 397 398 Input Parameters: 399 + a - pointer to string first string 400 - b - pointer to second string 401 402 Output Parameter: 403 . flg - PETSC_TRUE if the two strings are equal 404 405 Level: intermediate 406 407 Notes: Not for use in Fortran 408 409 .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp() 410 411 @*/ 412 PetscErrorCode PetscStrcmp(const char a[],const char b[],PetscBool *flg) 413 { 414 int c; 415 416 PetscFunctionBegin; 417 if (!a && !b) *flg = PETSC_TRUE; 418 else if (!a || !b) *flg = PETSC_FALSE; 419 else { 420 c = strcmp(a,b); 421 if (c) *flg = PETSC_FALSE; 422 else *flg = PETSC_TRUE; 423 } 424 PetscFunctionReturn(0); 425 } 426 427 #undef __FUNCT__ 428 #define __FUNCT__ "PetscStrgrt" 429 /*@C 430 PetscStrgrt - If first string is greater than the second 431 432 Not Collective 433 434 Input Parameters: 435 + a - pointer to first string 436 - b - pointer to second string 437 438 Output Parameter: 439 . flg - if the first string is greater 440 441 Notes: 442 Null arguments are ok, a null string is considered smaller than 443 all others 444 445 Not for use in Fortran 446 447 Level: intermediate 448 449 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp() 450 451 @*/ 452 PetscErrorCode PetscStrgrt(const char a[],const char b[],PetscBool *t) 453 { 454 int c; 455 456 PetscFunctionBegin; 457 if (!a && !b) *t = PETSC_FALSE; 458 else if (a && !b) *t = PETSC_TRUE; 459 else if (!a && b) *t = PETSC_FALSE; 460 else { 461 c = strcmp(a,b); 462 if (c > 0) *t = PETSC_TRUE; 463 else *t = PETSC_FALSE; 464 } 465 PetscFunctionReturn(0); 466 } 467 468 #undef __FUNCT__ 469 #define __FUNCT__ "PetscStrcasecmp" 470 /*@C 471 PetscStrcasecmp - Returns true if the two strings are the same 472 except possibly for case. 473 474 Not Collective 475 476 Input Parameters: 477 + a - pointer to first string 478 - b - pointer to second string 479 480 Output Parameter: 481 . flg - if the two strings are the same 482 483 Notes: 484 Null arguments are ok 485 486 Not for use in Fortran 487 488 Level: intermediate 489 490 .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt() 491 492 @*/ 493 PetscErrorCode PetscStrcasecmp(const char a[],const char b[],PetscBool *t) 494 { 495 int c; 496 497 PetscFunctionBegin; 498 if (!a && !b) c = 0; 499 else if (!a || !b) c = 1; 500 #if defined(PETSC_HAVE_STRCASECMP) 501 else c = strcasecmp(a,b); 502 #elif defined(PETSC_HAVE_STRICMP) 503 else c = stricmp(a,b); 504 #else 505 else { 506 char *aa,*bb; 507 PetscErrorCode ierr; 508 ierr = PetscStrallocpy(a,&aa);CHKERRQ(ierr); 509 ierr = PetscStrallocpy(b,&bb);CHKERRQ(ierr); 510 ierr = PetscStrtolower(aa);CHKERRQ(ierr); 511 ierr = PetscStrtolower(bb);CHKERRQ(ierr); 512 ierr = PetscStrcmp(aa,bb,t);CHKERRQ(ierr); 513 ierr = PetscFree(aa);CHKERRQ(ierr); 514 ierr = PetscFree(bb);CHKERRQ(ierr); 515 PetscFunctionReturn(0); 516 } 517 #endif 518 if (!c) *t = PETSC_TRUE; 519 else *t = PETSC_FALSE; 520 PetscFunctionReturn(0); 521 } 522 523 524 525 #undef __FUNCT__ 526 #define __FUNCT__ "PetscStrncmp" 527 /*@C 528 PetscStrncmp - Compares two strings, up to a certain length 529 530 Not Collective 531 532 Input Parameters: 533 + a - pointer to first string 534 . b - pointer to second string 535 - n - length to compare up to 536 537 Output Parameter: 538 . t - if the two strings are equal 539 540 Level: intermediate 541 542 Notes: Not for use in Fortran 543 544 .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp() 545 546 @*/ 547 PetscErrorCode PetscStrncmp(const char a[],const char b[],size_t n,PetscBool *t) 548 { 549 int c; 550 551 PetscFunctionBegin; 552 c = strncmp(a,b,n); 553 if (!c) *t = PETSC_TRUE; 554 else *t = PETSC_FALSE; 555 PetscFunctionReturn(0); 556 } 557 558 #undef __FUNCT__ 559 #define __FUNCT__ "PetscStrchr" 560 /*@C 561 PetscStrchr - Locates first occurance of a character in a string 562 563 Not Collective 564 565 Input Parameters: 566 + a - pointer to string 567 - b - character 568 569 Output Parameter: 570 . c - location of occurance, NULL if not found 571 572 Level: intermediate 573 574 Notes: Not for use in Fortran 575 576 @*/ 577 PetscErrorCode PetscStrchr(const char a[],char b,char *c[]) 578 { 579 PetscFunctionBegin; 580 *c = (char*)strchr(a,b); 581 PetscFunctionReturn(0); 582 } 583 584 #undef __FUNCT__ 585 #define __FUNCT__ "PetscStrrchr" 586 /*@C 587 PetscStrrchr - Locates one location past the last occurance of a character in a string, 588 if the character is not found then returns entire string 589 590 Not Collective 591 592 Input Parameters: 593 + a - pointer to string 594 - b - character 595 596 Output Parameter: 597 . tmp - location of occurance, a if not found 598 599 Level: intermediate 600 601 Notes: Not for use in Fortran 602 603 @*/ 604 PetscErrorCode PetscStrrchr(const char a[],char b,char *tmp[]) 605 { 606 PetscFunctionBegin; 607 *tmp = (char*)strrchr(a,b); 608 if (!*tmp) *tmp = (char*)a; 609 else *tmp = *tmp + 1; 610 PetscFunctionReturn(0); 611 } 612 613 #undef __FUNCT__ 614 #define __FUNCT__ "PetscStrtolower" 615 /*@C 616 PetscStrtolower - Converts string to lower case 617 618 Not Collective 619 620 Input Parameters: 621 . a - pointer to string 622 623 Level: intermediate 624 625 Notes: Not for use in Fortran 626 627 @*/ 628 PetscErrorCode PetscStrtolower(char a[]) 629 { 630 PetscFunctionBegin; 631 while (*a) { 632 if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A'; 633 a++; 634 } 635 PetscFunctionReturn(0); 636 } 637 638 #undef __FUNCT__ 639 #define __FUNCT__ "PetscStrtoupper" 640 /*@C 641 PetscStrtolower - Converts string to upper case 642 643 Not Collective 644 645 Input Parameters: 646 . a - pointer to string 647 648 Level: intermediate 649 650 Notes: Not for use in Fortran 651 652 @*/ 653 PetscErrorCode PetscStrtoupper(char a[]) 654 { 655 PetscFunctionBegin; 656 while (*a) { 657 if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a'; 658 a++; 659 } 660 PetscFunctionReturn(0); 661 } 662 663 #undef __FUNCT__ 664 #define __FUNCT__ "PetscStrendswith" 665 /*@C 666 PetscStrendswith - Determines if a string ends with a certain string 667 668 Not Collective 669 670 Input Parameters: 671 + a - pointer to string 672 - b - string to endwith 673 674 Output Parameter: 675 . flg - PETSC_TRUE or PETSC_FALSE 676 677 Notes: Not for use in Fortran 678 679 Level: intermediate 680 681 @*/ 682 PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg) 683 { 684 char *test; 685 PetscErrorCode ierr; 686 size_t na,nb; 687 688 PetscFunctionBegin; 689 *flg = PETSC_FALSE; 690 ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr); 691 if (test) { 692 ierr = PetscStrlen(a,&na);CHKERRQ(ierr); 693 ierr = PetscStrlen(b,&nb);CHKERRQ(ierr); 694 if (a+na-nb == test) *flg = PETSC_TRUE; 695 } 696 PetscFunctionReturn(0); 697 } 698 699 #undef __FUNCT__ 700 #define __FUNCT__ "PetscStrbeginswith" 701 /*@C 702 PetscStrbeginswith - Determines if a string begins with a certain string 703 704 Not Collective 705 706 Input Parameters: 707 + a - pointer to string 708 - b - string to beginwith 709 710 Output Parameter: 711 . flg - PETSC_TRUE or PETSC_FALSE 712 713 Notes: Not for use in Fortran 714 715 Level: intermediate 716 717 @*/ 718 PetscErrorCode PetscStrbeginswith(const char a[],const char b[],PetscBool *flg) 719 { 720 char *test; 721 PetscErrorCode ierr; 722 723 PetscFunctionBegin; 724 *flg = PETSC_FALSE; 725 ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr); 726 if (test && (test == a)) *flg = PETSC_TRUE; 727 PetscFunctionReturn(0); 728 } 729 730 731 #undef __FUNCT__ 732 #define __FUNCT__ "PetscStrendswithwhich" 733 /*@C 734 PetscStrendswithwhich - Determines if a string ends with one of several possible strings 735 736 Not Collective 737 738 Input Parameters: 739 + a - pointer to string 740 - bs - strings to endwith (last entry must be null) 741 742 Output Parameter: 743 . cnt - the index of the string it ends with or 1+the last possible index 744 745 Notes: Not for use in Fortran 746 747 Level: intermediate 748 749 @*/ 750 PetscErrorCode PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt) 751 { 752 PetscBool flg; 753 PetscErrorCode ierr; 754 755 PetscFunctionBegin; 756 *cnt = 0; 757 while (bs[*cnt]) { 758 ierr = PetscStrendswith(a,bs[*cnt],&flg);CHKERRQ(ierr); 759 if (flg) PetscFunctionReturn(0); 760 *cnt += 1; 761 } 762 PetscFunctionReturn(0); 763 } 764 765 #undef __FUNCT__ 766 #define __FUNCT__ "PetscStrrstr" 767 /*@C 768 PetscStrrstr - Locates last occurance of string in another string 769 770 Not Collective 771 772 Input Parameters: 773 + a - pointer to string 774 - b - string to find 775 776 Output Parameter: 777 . tmp - location of occurance 778 779 Notes: Not for use in Fortran 780 781 Level: intermediate 782 783 @*/ 784 PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[]) 785 { 786 const char *stmp = a, *ltmp = 0; 787 788 PetscFunctionBegin; 789 while (stmp) { 790 stmp = (char*)strstr(stmp,b); 791 if (stmp) {ltmp = stmp;stmp++;} 792 } 793 *tmp = (char*)ltmp; 794 PetscFunctionReturn(0); 795 } 796 797 #undef __FUNCT__ 798 #define __FUNCT__ "PetscStrstr" 799 /*@C 800 PetscStrstr - Locates first occurance of string in another string 801 802 Not Collective 803 804 Input Parameters: 805 + haystack - string to search 806 - needle - string to find 807 808 Output Parameter: 809 . tmp - location of occurance, is a NULL if the string is not found 810 811 Notes: Not for use in Fortran 812 813 Level: intermediate 814 815 @*/ 816 PetscErrorCode PetscStrstr(const char haystack[],const char needle[],char *tmp[]) 817 { 818 PetscFunctionBegin; 819 *tmp = (char*)strstr(haystack,needle); 820 PetscFunctionReturn(0); 821 } 822 823 struct _p_PetscToken {char token;char *array;char *current;}; 824 825 #undef __FUNCT__ 826 #define __FUNCT__ "PetscTokenFind" 827 /*@C 828 PetscTokenFind - Locates next "token" in a string 829 830 Not Collective 831 832 Input Parameters: 833 . a - pointer to token 834 835 Output Parameter: 836 . result - location of occurance, NULL if not found 837 838 Notes: 839 840 This version is different from the system version in that 841 it allows you to pass a read-only string into the function. 842 843 This version also treats all characters etc. inside a double quote " 844 as a single token. 845 846 Not for use in Fortran 847 848 Level: intermediate 849 850 851 .seealso: PetscTokenCreate(), PetscTokenDestroy() 852 @*/ 853 PetscErrorCode PetscTokenFind(PetscToken a,char *result[]) 854 { 855 char *ptr = a->current,token; 856 857 PetscFunctionBegin; 858 *result = a->current; 859 if (ptr && !*ptr) {*result = 0;PetscFunctionReturn(0);} 860 token = a->token; 861 if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;} 862 while (ptr) { 863 if (*ptr == token) { 864 *ptr++ = 0; 865 while (*ptr == a->token) ptr++; 866 a->current = ptr; 867 break; 868 } 869 if (!*ptr) { 870 a->current = 0; 871 break; 872 } 873 ptr++; 874 } 875 PetscFunctionReturn(0); 876 } 877 878 #undef __FUNCT__ 879 #define __FUNCT__ "PetscTokenCreate" 880 /*@C 881 PetscTokenCreate - Creates a PetscToken used to find tokens in a string 882 883 Not Collective 884 885 Input Parameters: 886 + string - the string to look in 887 - token - the character to look for 888 889 Output Parameter: 890 . a - pointer to token 891 892 Notes: 893 894 This version is different from the system version in that 895 it allows you to pass a read-only string into the function. 896 897 Not for use in Fortran 898 899 Level: intermediate 900 901 .seealso: PetscTokenFind(), PetscTokenDestroy() 902 @*/ 903 PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t) 904 { 905 PetscErrorCode ierr; 906 907 PetscFunctionBegin; 908 ierr = PetscNew(struct _p_PetscToken,t);CHKERRQ(ierr); 909 ierr = PetscStrallocpy(a,&(*t)->array);CHKERRQ(ierr); 910 911 (*t)->current = (*t)->array; 912 (*t)->token = b; 913 PetscFunctionReturn(0); 914 } 915 916 #undef __FUNCT__ 917 #define __FUNCT__ "PetscTokenDestroy" 918 /*@C 919 PetscTokenDestroy - Destroys a PetscToken 920 921 Not Collective 922 923 Input Parameters: 924 . a - pointer to token 925 926 Level: intermediate 927 928 Notes: Not for use in Fortran 929 930 .seealso: PetscTokenCreate(), PetscTokenFind() 931 @*/ 932 PetscErrorCode PetscTokenDestroy(PetscToken *a) 933 { 934 PetscErrorCode ierr; 935 936 PetscFunctionBegin; 937 if (!*a) PetscFunctionReturn(0); 938 ierr = PetscFree((*a)->array);CHKERRQ(ierr); 939 ierr = PetscFree(*a);CHKERRQ(ierr); 940 PetscFunctionReturn(0); 941 } 942 943 944 #undef __FUNCT__ 945 #define __FUNCT__ "PetscGetPetscDir" 946 /*@C 947 PetscGetPetscDir - Gets the directory PETSc is installed in 948 949 Not Collective 950 951 Output Parameter: 952 . dir - the directory 953 954 Level: developer 955 956 Notes: Not for use in Fortran 957 958 @*/ 959 PetscErrorCode PetscGetPetscDir(const char *dir[]) 960 { 961 PetscFunctionBegin; 962 *dir = PETSC_DIR; 963 PetscFunctionReturn(0); 964 } 965 966 #undef __FUNCT__ 967 #define __FUNCT__ "PetscStrreplace" 968 /*@C 969 PetscStrreplace - Replaces substrings in string with other substrings 970 971 Not Collective 972 973 Input Parameters: 974 + comm - MPI_Comm of processors that are processing the string 975 . aa - the string to look in 976 . b - the resulting copy of a with replaced strings (b can be the same as a) 977 - len - the length of b 978 979 Notes: 980 Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY}, 981 ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values 982 as well as any environmental variables. 983 984 PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what 985 PETSc was built with and do not use environmental variables. 986 987 Not for use in Fortran 988 989 Level: intermediate 990 991 @*/ 992 PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len) 993 { 994 PetscErrorCode ierr; 995 int i = 0; 996 size_t l,l1,l2,l3; 997 char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa; 998 const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0}; 999 const char *r[] = {0,0,0,0,0,0,0,0,0}; 1000 PetscBool flag; 1001 1002 PetscFunctionBegin; 1003 if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull"); 1004 if (aa == b) { 1005 ierr = PetscStrallocpy(aa,(char**)&a);CHKERRQ(ierr); 1006 } 1007 ierr = PetscMalloc(len*sizeof(char*),&work);CHKERRQ(ierr); 1008 1009 /* get values for replaced variables */ 1010 ierr = PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);CHKERRQ(ierr); 1011 ierr = PetscStrallocpy(PETSC_DIR,(char**)&r[1]);CHKERRQ(ierr); 1012 ierr = PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);CHKERRQ(ierr); 1013 ierr = PetscMalloc(256*sizeof(char),&r[3]);CHKERRQ(ierr); 1014 ierr = PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[4]);CHKERRQ(ierr); 1015 ierr = PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[5]);CHKERRQ(ierr); 1016 ierr = PetscMalloc(256*sizeof(char),&r[6]);CHKERRQ(ierr); 1017 ierr = PetscMalloc(256*sizeof(char),&r[7]);CHKERRQ(ierr); 1018 ierr = PetscGetDisplay((char*)r[3],256);CHKERRQ(ierr); 1019 ierr = PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);CHKERRQ(ierr); 1020 ierr = PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);CHKERRQ(ierr); 1021 ierr = PetscGetUserName((char*)r[6],256);CHKERRQ(ierr); 1022 ierr = PetscGetHostName((char*)r[7],256);CHKERRQ(ierr); 1023 1024 /* replace that are in environment */ 1025 ierr = PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);CHKERRQ(ierr); 1026 if (flag) { 1027 ierr = PetscStrallocpy(env,(char**)&r[2]);CHKERRQ(ierr); 1028 } 1029 1030 /* replace the requested strings */ 1031 ierr = PetscStrncpy(b,a,len);CHKERRQ(ierr); 1032 while (s[i]) { 1033 ierr = PetscStrlen(s[i],&l);CHKERRQ(ierr); 1034 ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr); 1035 while (par) { 1036 *par = 0; 1037 par += l; 1038 1039 ierr = PetscStrlen(b,&l1);CHKERRQ(ierr); 1040 ierr = PetscStrlen(r[i],&l2);CHKERRQ(ierr); 1041 ierr = PetscStrlen(par,&l3);CHKERRQ(ierr); 1042 if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values"); 1043 ierr = PetscStrcpy(work,b);CHKERRQ(ierr); 1044 ierr = PetscStrcat(work,r[i]);CHKERRQ(ierr); 1045 ierr = PetscStrcat(work,par);CHKERRQ(ierr); 1046 ierr = PetscStrncpy(b,work,len);CHKERRQ(ierr); 1047 ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr); 1048 } 1049 i++; 1050 } 1051 i = 0; 1052 while (r[i]) { 1053 tfree = (char*)r[i]; 1054 ierr = PetscFree(tfree);CHKERRQ(ierr); 1055 i++; 1056 } 1057 1058 /* look for any other ${xxx} strings to replace from environmental variables */ 1059 ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr); 1060 while (par) { 1061 *par = 0; 1062 par += 2; 1063 ierr = PetscStrcpy(work,b);CHKERRQ(ierr); 1064 ierr = PetscStrstr(par,"}",&epar);CHKERRQ(ierr); 1065 *epar = 0; 1066 epar += 1; 1067 ierr = PetscOptionsGetenv(comm,par,env,256,&flag);CHKERRQ(ierr); 1068 if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par); 1069 ierr = PetscStrcat(work,env);CHKERRQ(ierr); 1070 ierr = PetscStrcat(work,epar);CHKERRQ(ierr); 1071 ierr = PetscStrcpy(b,work);CHKERRQ(ierr); 1072 ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr); 1073 } 1074 ierr = PetscFree(work);CHKERRQ(ierr); 1075 if (aa == b) { 1076 ierr = PetscFree(a);CHKERRQ(ierr); 1077 } 1078 PetscFunctionReturn(0); 1079 } 1080 1081 1082