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