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