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