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 - 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 struct _p_PetscToken {char token;char *array;char *current;}; 569 570 571 #undef __FUNCT__ 572 #define __FUNCT__ "PetscTokenFind" 573 /*@C 574 PetscTokenFind - Locates next "token" in a string 575 576 Not Collective 577 578 Input Parameters: 579 . a - pointer to token 580 581 Output Parameter: 582 . result - location of occurance, PETSC_NULL if not found 583 584 Notes: 585 586 This version is different from the system version in that 587 it allows you to pass a read-only string into the function. 588 589 This version also treats all characters etc. inside a double quote " 590 as a single token. 591 592 Not for use in Fortran 593 594 Level: intermediate 595 596 597 .seealso: PetscTokenCreate(), PetscTokenDestroy() 598 @*/ 599 PetscErrorCode PetscTokenFind(PetscToken a,char *result[]) 600 { 601 char *ptr = a->current,token; 602 603 PetscFunctionBegin; 604 *result = a->current; 605 if (ptr && !*ptr) {*result = 0;PetscFunctionReturn(0);} 606 token = a->token; 607 if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;} 608 while (ptr) { 609 if (*ptr == token) { 610 *ptr++ = 0; 611 while (*ptr == a->token) ptr++; 612 a->current = ptr; 613 break; 614 } 615 if (!*ptr) { 616 a->current = 0; 617 break; 618 } 619 ptr++; 620 } 621 PetscFunctionReturn(0); 622 } 623 624 #undef __FUNCT__ 625 #define __FUNCT__ "PetscTokenCreate" 626 /*@C 627 PetscTokenCreate - Creates a PetscToken used to find tokens in a string 628 629 Not Collective 630 631 Input Parameters: 632 + string - the string to look in 633 - token - the character to look for 634 635 Output Parameter: 636 . a - pointer to token 637 638 Notes: 639 640 This version is different from the system version in that 641 it allows you to pass a read-only string into the function. 642 643 Not for use in Fortran 644 645 Level: intermediate 646 647 .seealso: PetscTokenFind(), PetscTokenDestroy() 648 @*/ 649 PetscErrorCode PetscTokenCreate(const char a[],const char b,PetscToken *t) 650 { 651 PetscErrorCode ierr; 652 653 PetscFunctionBegin; 654 ierr = PetscNew(struct _p_PetscToken,t);CHKERRQ(ierr); 655 ierr = PetscStrallocpy(a,&(*t)->array);CHKERRQ(ierr); 656 (*t)->current = (*t)->array; 657 (*t)->token = b; 658 PetscFunctionReturn(0); 659 } 660 661 #undef __FUNCT__ 662 #define __FUNCT__ "PetscTokenDestroy" 663 /*@C 664 PetscTokenDestroy - Destroys a PetscToken 665 666 Not Collective 667 668 Input Parameters: 669 . a - pointer to token 670 671 Level: intermediate 672 673 Notes: Not for use in Fortran 674 675 .seealso: PetscTokenCreate(), PetscTokenFind() 676 @*/ 677 PetscErrorCode PetscTokenDestroy(PetscToken a) 678 { 679 PetscErrorCode ierr; 680 681 PetscFunctionBegin; 682 ierr = PetscFree(a->array);CHKERRQ(ierr); 683 ierr = PetscFree(a);CHKERRQ(ierr); 684 PetscFunctionReturn(0); 685 } 686 687 #undef __FUNCT__ 688 #define __FUNCT__ "PetscStrendswith" 689 /*@C 690 PetscStrendswith - Determines if a string ends with a certain string 691 692 Not Collective 693 694 Input Parameters: 695 + a - pointer to string 696 - b - string to endwith 697 698 Output Parameter: 699 . flg - PETSC_TRUE or PETSC_FALSE 700 701 Notes: Not for use in Fortran 702 703 Level: intermediate 704 705 @*/ 706 PetscErrorCode PetscStrendswith(const char a[],const char b[],PetscBool *flg) 707 { 708 char *test; 709 PetscErrorCode ierr; 710 size_t na,nb; 711 712 PetscFunctionBegin; 713 *flg = PETSC_FALSE; 714 ierr = PetscStrrstr(a,b,&test);CHKERRQ(ierr); 715 if (test) { 716 ierr = PetscStrlen(a,&na);CHKERRQ(ierr); 717 ierr = PetscStrlen(b,&nb);CHKERRQ(ierr); 718 if (a+na-nb == test) *flg = PETSC_TRUE; 719 } 720 PetscFunctionReturn(0); 721 } 722 723 724 #undef __FUNCT__ 725 #define __FUNCT__ "PetscStrrstr" 726 /*@C 727 PetscStrrstr - Locates last occurance of string in another string 728 729 Not Collective 730 731 Input Parameters: 732 + a - pointer to string 733 - b - string to find 734 735 Output Parameter: 736 . tmp - location of occurance 737 738 Notes: Not for use in Fortran 739 740 Level: intermediate 741 742 @*/ 743 PetscErrorCode PetscStrrstr(const char a[],const char b[],char *tmp[]) 744 { 745 const char *stmp = a, *ltmp = 0; 746 747 PetscFunctionBegin; 748 while (stmp) { 749 stmp = (char *)strstr(stmp,b); 750 if (stmp) {ltmp = stmp;stmp++;} 751 } 752 *tmp = (char *)ltmp; 753 PetscFunctionReturn(0); 754 } 755 756 #undef __FUNCT__ 757 #define __FUNCT__ "PetscStrstr" 758 /*@C 759 PetscStrstr - Locates first occurance of string in another string 760 761 Not Collective 762 763 Input Parameters: 764 + a - pointer to string 765 - b - string to find 766 767 Output Parameter: 768 . tmp - location of occurance, is a PETSC_NULL if the string is not found 769 770 Notes: Not for use in Fortran 771 772 Level: intermediate 773 774 @*/ 775 PetscErrorCode PetscStrstr(const char a[],const char b[],char *tmp[]) 776 { 777 PetscFunctionBegin; 778 *tmp = (char *)strstr(a,b); 779 PetscFunctionReturn(0); 780 } 781 782 #undef __FUNCT__ 783 #define __FUNCT__ "PetscGetPetscDir" 784 /*@C 785 PetscGetPetscDir - Gets the directory PETSc is installed in 786 787 Not Collective 788 789 Output Parameter: 790 . dir - the directory 791 792 Level: developer 793 794 Notes: Not for use in Fortran 795 796 @*/ 797 PetscErrorCode PetscGetPetscDir(const char *dir[]) 798 { 799 PetscFunctionBegin; 800 *dir = PETSC_DIR; 801 PetscFunctionReturn(0); 802 } 803 804 #undef __FUNCT__ 805 #define __FUNCT__ "PetscStrreplace" 806 /*@C 807 PetscStrreplace - Replaces substrings in string with other substrings 808 809 Not Collective 810 811 Input Parameters: 812 + comm - MPI_Comm of processors that are processing the string 813 . aa - the string to look in 814 . b - the resulting copy of a with replaced strings (b can be the same as a) 815 - len - the length of b 816 817 Notes: 818 Replaces ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY}, 819 ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values 820 as well as any environmental variables. 821 822 PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what 823 PETSc was built with and do not use environmental variables. 824 825 Not for use in Fortran 826 827 Level: intermediate 828 829 @*/ 830 PetscErrorCode PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len) 831 { 832 PetscErrorCode ierr; 833 int i = 0; 834 size_t l,l1,l2,l3; 835 char *work,*par,*epar,env[1024],*tfree,*a = (char*)aa; 836 const char *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",0}; 837 const char *r[] = {0,0,0,0,0,0,0,0,0}; 838 PetscBool flag; 839 840 PetscFunctionBegin; 841 if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull"); 842 if (aa == b) { 843 ierr = PetscStrallocpy(aa,(char **)&a);CHKERRQ(ierr); 844 } 845 ierr = PetscMalloc(len*sizeof(char*),&work);CHKERRQ(ierr); 846 847 /* get values for replaced variables */ 848 ierr = PetscStrallocpy(PETSC_ARCH,(char**)&r[0]);CHKERRQ(ierr); 849 ierr = PetscStrallocpy(PETSC_DIR,(char**)&r[1]);CHKERRQ(ierr); 850 ierr = PetscStrallocpy(PETSC_LIB_DIR,(char**)&r[2]);CHKERRQ(ierr); 851 ierr = PetscMalloc(256*sizeof(char),&r[3]);CHKERRQ(ierr); 852 ierr = PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[4]);CHKERRQ(ierr); 853 ierr = PetscMalloc(PETSC_MAX_PATH_LEN*sizeof(char),&r[5]);CHKERRQ(ierr); 854 ierr = PetscMalloc(256*sizeof(char),&r[6]);CHKERRQ(ierr); 855 ierr = PetscMalloc(256*sizeof(char),&r[7]);CHKERRQ(ierr); 856 ierr = PetscGetDisplay((char*)r[3],256);CHKERRQ(ierr); 857 ierr = PetscGetHomeDirectory((char*)r[4],PETSC_MAX_PATH_LEN);CHKERRQ(ierr); 858 ierr = PetscGetWorkingDirectory((char*)r[5],PETSC_MAX_PATH_LEN);CHKERRQ(ierr); 859 ierr = PetscGetUserName((char*)r[6],256);CHKERRQ(ierr); 860 ierr = PetscGetHostName((char*)r[7],256);CHKERRQ(ierr); 861 862 /* replace that are in environment */ 863 ierr = PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,1024,&flag);CHKERRQ(ierr); 864 if (flag) { 865 ierr = PetscStrallocpy(env,(char**)&r[2]);CHKERRQ(ierr); 866 } 867 868 /* replace the requested strings */ 869 ierr = PetscStrncpy(b,a,len);CHKERRQ(ierr); 870 while (s[i]) { 871 ierr = PetscStrlen(s[i],&l);CHKERRQ(ierr); 872 ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr); 873 while (par) { 874 *par = 0; 875 par += l; 876 877 ierr = PetscStrlen(b,&l1);CHKERRQ(ierr); 878 ierr = PetscStrlen(r[i],&l2);CHKERRQ(ierr); 879 ierr = PetscStrlen(par,&l3);CHKERRQ(ierr); 880 if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values"); 881 ierr = PetscStrcpy(work,b);CHKERRQ(ierr); 882 ierr = PetscStrcat(work,r[i]);CHKERRQ(ierr); 883 ierr = PetscStrcat(work,par);CHKERRQ(ierr); 884 ierr = PetscStrncpy(b,work,len);CHKERRQ(ierr); 885 ierr = PetscStrstr(b,s[i],&par);CHKERRQ(ierr); 886 } 887 i++; 888 } 889 i = 0; 890 while (r[i]) { 891 tfree = (char*)r[i]; 892 ierr = PetscFree(tfree);CHKERRQ(ierr); 893 i++; 894 } 895 896 /* look for any other ${xxx} strings to replace from environmental variables */ 897 ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr); 898 while (par) { 899 *par = 0; 900 par += 2; 901 ierr = PetscStrcpy(work,b);CHKERRQ(ierr); 902 ierr = PetscStrstr(par,"}",&epar);CHKERRQ(ierr); 903 *epar = 0; 904 epar += 1; 905 ierr = PetscOptionsGetenv(comm,par,env,256,&flag);CHKERRQ(ierr); 906 if (!flag) { 907 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par); 908 } 909 ierr = PetscStrcat(work,env);CHKERRQ(ierr); 910 ierr = PetscStrcat(work,epar);CHKERRQ(ierr); 911 ierr = PetscStrcpy(b,work);CHKERRQ(ierr); 912 ierr = PetscStrstr(b,"${",&par);CHKERRQ(ierr); 913 } 914 ierr = PetscFree(work);CHKERRQ(ierr); 915 if (aa == b) { 916 ierr = PetscFree(a);CHKERRQ(ierr); 917 } 918 PetscFunctionReturn(0); 919 } 920 921 922