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