Date: 2021-03-03T22:25:43+00:00

Actual source code: str.c
petsc-3.14.5 2021-03-03
Report Typos and Errors

      1: /*
      2:     We define the string operations here. The reason we just do not use
      3:   the standard string routines in the PETSc code is that on some machines
      4:   they are broken or have the wrong prototypes.

      6: */
      7: #include <petscsys.h>
      8: #if defined(PETSC_HAVE_STRINGS_H)
      9: #  include <strings.h>          /* strcasecmp */
     10: #endif

     12: /*@C
     13:    PetscStrToArray - Separates a string by a character (for example ' ' or '\n') and creates an array of strings

     15:    Not Collective

     17:    Input Parameters:
     18: +  s - pointer to string
     19: -  sp - separator character

     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

     25:    Level: intermediate

     27:    Notes:
     28:     this may be called before PetscInitialize() or after PetscFinalize()

     30:    Not for use in Fortran

     32:    Developer Notes:
     33:     Using raw malloc() and does not call error handlers since this may be used before PETSc is initialized. Used
     34:      to generate argc, args arguments passed to MPI_Init()

     36: .seealso: PetscStrToArrayDestroy(), PetscToken, PetscTokenCreate()

     38: @*/
     39: PetscErrorCode  PetscStrToArray(const char s[],char sp,int *argc,char ***args)
     40: {
     41:   int       i,j,n,*lens,cnt = 0;
     42:   PetscBool flg = PETSC_FALSE;

     44:   if (!s) n = 0;
     45:   else    n = strlen(s);
     46:   *argc = 0;
     47:   *args = NULL;
     48:   for (; n>0; n--) {   /* remove separator chars at the end - and will empty the string if all chars are separator chars */
     49:     if (s[n-1] != sp) break;
     50:   }
     51:   if (!n) {
     52:     return(0);
     53:   }
     54:   for (i=0; i<n; i++) {
     55:     if (s[i] != sp) break;
     56:   }
     57:   for (;i<n+1; i++) {
     58:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
     59:     else if (s[i] != sp) {flg = PETSC_FALSE;}
     60:   }
     61:   (*args) = (char**) malloc(((*argc)+1)*sizeof(char*)); if (!*args) return PETSC_ERR_MEM;
     62:   lens    = (int*) malloc((*argc)*sizeof(int)); if (!lens) return PETSC_ERR_MEM;
     63:   for (i=0; i<*argc; i++) lens[i] = 0;

     65:   *argc = 0;
     66:   for (i=0; i<n; i++) {
     67:     if (s[i] != sp) break;
     68:   }
     69:   for (;i<n+1; i++) {
     70:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*argc)++;}
     71:     else if (s[i] != sp) {lens[*argc]++;flg = PETSC_FALSE;}
     72:   }

     74:   for (i=0; i<*argc; i++) {
     75:     (*args)[i] = (char*) malloc((lens[i]+1)*sizeof(char));
     76:     if (!(*args)[i]) {
     77:       free(lens);
     78:       for (j=0; j<i; j++) free((*args)[j]);
     79:       free(*args);
     80:       return PETSC_ERR_MEM;
     81:     }
     82:   }
     83:   free(lens);
     84:   (*args)[*argc] = NULL;

     86:   *argc = 0;
     87:   for (i=0; i<n; i++) {
     88:     if (s[i] != sp) break;
     89:   }
     90:   for (;i<n+1; i++) {
     91:     if ((s[i] == sp || s[i] == 0) && !flg) {flg = PETSC_TRUE; (*args)[*argc][cnt++] = 0; (*argc)++; cnt = 0;}
     92:     else if (s[i] != sp && s[i] != 0) {(*args)[*argc][cnt++] = s[i]; flg = PETSC_FALSE;}
     93:   }
     94:   return 0;
     95: }

     97: /*@C
     98:    PetscStrToArrayDestroy - Frees array created with PetscStrToArray().

    100:    Not Collective

    102:    Output Parameters:
    103: +  argc - the number of arguments
    104: -  args - the array of arguments

    106:    Level: intermediate

    108:    Notes:
    109:     This may be called before PetscInitialize() or after PetscFinalize()

    111:    Not for use in Fortran

    113: .seealso: PetscStrToArray()

    115: @*/
    116: PetscErrorCode  PetscStrToArrayDestroy(int argc,char **args)
    117: {
    118:   PetscInt i;

    120:   for (i=0; i<argc; i++) free(args[i]);
    121:   if (args) free(args);
    122:   return 0;
    123: }

    125: /*@C
    126:    PetscStrlen - Gets length of a string

    128:    Not Collective

    130:    Input Parameters:
    131: .  s - pointer to string

    133:    Output Parameter:
    134: .  len - length in bytes

    136:    Level: intermediate

    138:    Note:
    139:    This routine is analogous to strlen().

    141:    Null string returns a length of zero

    143:    Not for use in Fortran

    145: @*/
    146: PetscErrorCode  PetscStrlen(const char s[],size_t *len)
    147: {
    149:   if (!s) *len = 0;
    150:   else    *len = strlen(s);
    151:   return(0);
    152: }

    154: /*@C
    155:    PetscStrallocpy - Allocates space to hold a copy of a string then copies the string

    157:    Not Collective

    159:    Input Parameters:
    160: .  s - pointer to string

    162:    Output Parameter:
    163: .  t - the copied string

    165:    Level: intermediate

    167:    Note:
    168:       Null string returns a new null string

    170:       Not for use in Fortran

    172:       Warning: If t has previously been allocated then that memory is lost, you may need to PetscFree()
    173:       the array before calling this routine.

    175: .seealso: PetscStrArrayallocpy(), PetscStrcpy(), PetscStrNArrayallocpy()

    177: @*/
    178: PetscErrorCode  PetscStrallocpy(const char s[],char *t[])
    179: {
    181:   size_t         len;
    182:   char           *tmp = NULL;

    185:   if (s) {
    186:     PetscStrlen(s,&len);
    187:     PetscMalloc1(1+len,&tmp);
    188:     PetscStrcpy(tmp,s);
    189:   }
    190:   *t = tmp;
    191:   return(0);
    192: }

    194: /*@C
    195:    PetscStrArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings

    197:    Not Collective

    199:    Input Parameters:
    200: .  s - pointer to array of strings (final string is a null)

    202:    Output Parameter:
    203: .  t - the copied array string

    205:    Level: intermediate

    207:    Note:
    208:       Not for use in Fortran

    210:       Warning: If t has previously been allocated then that memory is lost, you may need to PetscStrArrayDestroy()
    211:       the array before calling this routine.

    213: .seealso: PetscStrallocpy(), PetscStrArrayDestroy(), PetscStrNArrayallocpy()

    215: @*/
    216: PetscErrorCode  PetscStrArrayallocpy(const char *const *list,char ***t)
    217: {
    219:   PetscInt       i,n = 0;

    222:   while (list[n++]) ;
    223:   PetscMalloc1(n+1,t);
    224:   for (i=0; i<n; i++) {
    225:     PetscStrallocpy(list[i],(*t)+i);
    226:   }
    227:   (*t)[n] = NULL;
    228:   return(0);
    229: }

    231: /*@C
    232:    PetscStrArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().

    234:    Not Collective

    236:    Output Parameters:
    237: .   list - array of strings

    239:    Level: intermediate

    241:    Notes:
    242:     Not for use in Fortran

    244: .seealso: PetscStrArrayallocpy()

    246: @*/
    247: PetscErrorCode PetscStrArrayDestroy(char ***list)
    248: {
    249:   PetscInt       n = 0;

    253:   if (!*list) return(0);
    254:   while ((*list)[n]) {
    255:     PetscFree((*list)[n]);
    256:     n++;
    257:   }
    258:   PetscFree(*list);
    259:   return(0);
    260: }

    262: /*@C
    263:    PetscStrNArrayallocpy - Allocates space to hold a copy of an array of strings then copies the strings

    265:    Not Collective

    267:    Input Parameters:
    268: +  n - the number of string entries
    269: -  s - pointer to array of strings

    271:    Output Parameter:
    272: .  t - the copied array string

    274:    Level: intermediate

    276:    Note:
    277:       Not for use in Fortran

    279: .seealso: PetscStrallocpy(), PetscStrArrayallocpy(), PetscStrNArrayDestroy()

    281: @*/
    282: PetscErrorCode  PetscStrNArrayallocpy(PetscInt n,const char *const *list,char ***t)
    283: {
    285:   PetscInt       i;

    288:   PetscMalloc1(n,t);
    289:   for (i=0; i<n; i++) {
    290:     PetscStrallocpy(list[i],(*t)+i);
    291:   }
    292:   return(0);
    293: }

    295: /*@C
    296:    PetscStrNArrayDestroy - Frees array of strings created with PetscStrArrayallocpy().

    298:    Not Collective

    300:    Output Parameters:
    301: +   n - number of string entries
    302: -   list - array of strings

    304:    Level: intermediate

    306:    Notes:
    307:     Not for use in Fortran

    309: .seealso: PetscStrArrayallocpy()

    311: @*/
    312: PetscErrorCode PetscStrNArrayDestroy(PetscInt n,char ***list)
    313: {
    315:   PetscInt       i;

    318:   if (!*list) return(0);
    319:   for (i=0; i<n; i++){
    320:     PetscFree((*list)[i]);
    321:   }
    322:   PetscFree(*list);
    323:   return(0);
    324: }

    326: /*@C
    327:    PetscStrcpy - Copies a string

    329:    Not Collective

    331:    Input Parameters:
    332: .  t - pointer to string

    334:    Output Parameter:
    335: .  s - the copied string

    337:    Level: intermediate

    339:    Notes:
    340:      Null string returns a string starting with zero

    342:      Not for use in Fortran

    344:      It is recommended you use PetscStrncpy() instead of this routine

    346: .seealso: PetscStrncpy(), PetscStrcat(), PetscStrlcat()

    348: @*/

    350: PetscErrorCode  PetscStrcpy(char s[],const char t[])
    351: {
    353:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
    354:   if (t) strcpy(s,t);
    355:   else if (s) s[0] = 0;
    356:   return(0);
    357: }

    359: /*@C
    360:    PetscStrncpy - Copies a string up to a certain length

    362:    Not Collective

    364:    Input Parameters:
    365: +  t - pointer to string
    366: -  n - the length to copy

    368:    Output Parameter:
    369: .  s - the copied string

    371:    Level: intermediate

    373:    Note:
    374:      Null string returns a string starting with zero

    376:      If the string that is being copied is of length n or larger then the entire string is not
    377:      copied and the final location of s is set to NULL. This is different then the behavior of
    378:      strncpy() which leaves s non-terminated if there is not room for the entire string.

    380:   Developers Note: Should this be PetscStrlcpy() to reflect its behavior which is like strlcpy() not strncpy()

    382: .seealso: PetscStrcpy(), PetscStrcat(), PetscStrlcat()

    384: @*/
    385: PetscErrorCode  PetscStrncpy(char s[],const char t[],size_t n)
    386: {
    388:   if (t && !s) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Trying to copy string into null pointer");
    389:   if (s && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"Requires an output string of length at least 1 to hold the termination character");
    390:   if (t) {
    391:     if (n > 1) {
    392:       strncpy(s,t,n-1);
    393:       s[n-1] = '\0';
    394:     } else {
    395:       s[0] = '\0';
    396:     }
    397:   } else if (s) s[0] = 0;
    398:   return(0);
    399: }

    401: /*@C
    402:    PetscStrcat - Concatenates a string onto a given string

    404:    Not Collective

    406:    Input Parameters:
    407: +  s - string to be added to
    408: -  t - pointer to string to be added to end

    410:    Level: intermediate

    412:    Notes:
    413:     Not for use in Fortran

    415:     It is recommended you use PetscStrlcat() instead of this routine

    417: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrlcat()

    419: @*/
    420: PetscErrorCode  PetscStrcat(char s[],const char t[])
    421: {
    423:   if (!t) return(0);
    424:   strcat(s,t);
    425:   return(0);
    426: }

    428: /*@C
    429:    PetscStrlcat - Concatenates a string onto a given string, up to a given length

    431:    Not Collective

    433:    Input Parameters:
    434: +  s - pointer to string to be added to at end
    435: .  t - string to be added to
    436: -  n - length of the original allocated string

    438:    Level: intermediate

    440:   Notes:
    441:   Not for use in Fortran

    443:   Unlike the system call strncat(), the length passed in is the length of the
    444:   original allocated space, not the length of the left-over space. This is
    445:   similar to the BSD system call strlcat().

    447: .seealso: PetscStrcpy(), PetscStrncpy(), PetscStrcat()

    449: @*/
    450: PetscErrorCode  PetscStrlcat(char s[],const char t[],size_t n)
    451: {
    452:   size_t         len;

    456:   if (t && !n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"String buffer length must be positive");
    457:   if (!t) return(0);
    458:   PetscStrlen(t,&len);
    459:   strncat(s,t,n - len);
    460:   s[n-1] = 0;
    461:   return(0);
    462: }

    464: void  PetscStrcmpNoError(const char a[],const char b[],PetscBool  *flg)
    465: {
    466:   int c;

    468:   if (!a && !b)      *flg = PETSC_TRUE;
    469:   else if (!a || !b) *flg = PETSC_FALSE;
    470:   else {
    471:     c = strcmp(a,b);
    472:     if (c) *flg = PETSC_FALSE;
    473:     else   *flg = PETSC_TRUE;
    474:   }
    475: }

    477: /*@C
    478:    PetscStrcmp - Compares two strings,

    480:    Not Collective

    482:    Input Parameters:
    483: +  a - pointer to string first string
    484: -  b - pointer to second string

    486:    Output Parameter:
    487: .  flg - PETSC_TRUE if the two strings are equal

    489:    Level: intermediate

    491:    Notes:
    492:     Not for use in Fortran

    494: .seealso: PetscStrgrt(), PetscStrncmp(), PetscStrcasecmp()

    496: @*/
    497: PetscErrorCode  PetscStrcmp(const char a[],const char b[],PetscBool  *flg)
    498: {
    499:   int c;

    502:   if (!a && !b)      *flg = PETSC_TRUE;
    503:   else if (!a || !b) *flg = PETSC_FALSE;
    504:   else {
    505:     c = strcmp(a,b);
    506:     if (c) *flg = PETSC_FALSE;
    507:     else   *flg = PETSC_TRUE;
    508:   }
    509:   return(0);
    510: }

    512: /*@C
    513:    PetscStrgrt - If first string is greater than the second

    515:    Not Collective

    517:    Input Parameters:
    518: +  a - pointer to first string
    519: -  b - pointer to second string

    521:    Output Parameter:
    522: .  flg - if the first string is greater

    524:    Notes:
    525:     Null arguments are ok, a null string is considered smaller than
    526:     all others

    528:    Not for use in Fortran

    530:    Level: intermediate

    532: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrcasecmp()

    534: @*/
    535: PetscErrorCode  PetscStrgrt(const char a[],const char b[],PetscBool  *t)
    536: {
    537:   int c;

    540:   if (!a && !b) *t = PETSC_FALSE;
    541:   else if (a && !b) *t = PETSC_TRUE;
    542:   else if (!a && b) *t = PETSC_FALSE;
    543:   else {
    544:     c = strcmp(a,b);
    545:     if (c > 0) *t = PETSC_TRUE;
    546:     else       *t = PETSC_FALSE;
    547:   }
    548:   return(0);
    549: }

    551: /*@C
    552:    PetscStrcasecmp - Returns true if the two strings are the same
    553:      except possibly for case.

    555:    Not Collective

    557:    Input Parameters:
    558: +  a - pointer to first string
    559: -  b - pointer to second string

    561:    Output Parameter:
    562: .  flg - if the two strings are the same

    564:    Notes:
    565:     Null arguments are ok

    567:    Not for use in Fortran

    569:    Level: intermediate

    571: .seealso: PetscStrcmp(), PetscStrncmp(), PetscStrgrt()

    573: @*/
    574: PetscErrorCode  PetscStrcasecmp(const char a[],const char b[],PetscBool  *t)
    575: {
    576:   int c;

    579:   if (!a && !b) c = 0;
    580:   else if (!a || !b) c = 1;
    581: #if defined(PETSC_HAVE_STRCASECMP)
    582:   else c = strcasecmp(a,b);
    583: #elif defined(PETSC_HAVE_STRICMP)
    584:   else c = stricmp(a,b);
    585: #else
    586:   else {
    587:     char           *aa,*bb;
    589:     PetscStrallocpy(a,&aa);
    590:     PetscStrallocpy(b,&bb);
    591:     PetscStrtolower(aa);
    592:     PetscStrtolower(bb);
    593:     PetscStrcmp(aa,bb,t);
    594:     PetscFree(aa);
    595:     PetscFree(bb);
    596:     return(0);
    597:   }
    598: #endif
    599:   if (!c) *t = PETSC_TRUE;
    600:   else    *t = PETSC_FALSE;
    601:   return(0);
    602: }

    606: /*@C
    607:    PetscStrncmp - Compares two strings, up to a certain length

    609:    Not Collective

    611:    Input Parameters:
    612: +  a - pointer to first string
    613: .  b - pointer to second string
    614: -  n - length to compare up to

    616:    Output Parameter:
    617: .  t - if the two strings are equal

    619:    Level: intermediate

    621:    Notes:
    622:     Not for use in Fortran

    624: .seealso: PetscStrgrt(), PetscStrcmp(), PetscStrcasecmp()

    626: @*/
    627: PetscErrorCode  PetscStrncmp(const char a[],const char b[],size_t n,PetscBool  *t)
    628: {
    629:   int c;

    632:   c = strncmp(a,b,n);
    633:   if (!c) *t = PETSC_TRUE;
    634:   else    *t = PETSC_FALSE;
    635:   return(0);
    636: }

    638: /*@C
    639:    PetscStrchr - Locates first occurance of a character in a string

    641:    Not Collective

    643:    Input Parameters:
    644: +  a - pointer to string
    645: -  b - character

    647:    Output Parameter:
    648: .  c - location of occurance, NULL if not found

    650:    Level: intermediate

    652:    Notes:
    653:     Not for use in Fortran

    655: @*/
    656: PetscErrorCode  PetscStrchr(const char a[],char b,char *c[])
    657: {
    659:   *c = (char*)strchr(a,b);
    660:   return(0);
    661: }

    663: /*@C
    664:    PetscStrrchr - Locates one location past the last occurance of a character in a string,
    665:       if the character is not found then returns entire string

    667:    Not Collective

    669:    Input Parameters:
    670: +  a - pointer to string
    671: -  b - character

    673:    Output Parameter:
    674: .  tmp - location of occurance, a if not found

    676:    Level: intermediate

    678:    Notes:
    679:     Not for use in Fortran

    681: @*/
    682: PetscErrorCode  PetscStrrchr(const char a[],char b,char *tmp[])
    683: {
    685:   *tmp = (char*)strrchr(a,b);
    686:   if (!*tmp) *tmp = (char*)a;
    687:   else *tmp = *tmp + 1;
    688:   return(0);
    689: }

    691: /*@C
    692:    PetscStrtolower - Converts string to lower case

    694:    Not Collective

    696:    Input Parameters:
    697: .  a - pointer to string

    699:    Level: intermediate

    701:    Notes:
    702:     Not for use in Fortran

    704: @*/
    705: PetscErrorCode  PetscStrtolower(char a[])
    706: {
    708:   while (*a) {
    709:     if (*a >= 'A' && *a <= 'Z') *a += 'a' - 'A';
    710:     a++;
    711:   }
    712:   return(0);
    713: }

    715: /*@C
    716:    PetscStrtoupper - Converts string to upper case

    718:    Not Collective

    720:    Input Parameters:
    721: .  a - pointer to string

    723:    Level: intermediate

    725:    Notes:
    726:     Not for use in Fortran

    728: @*/
    729: PetscErrorCode  PetscStrtoupper(char a[])
    730: {
    732:   while (*a) {
    733:     if (*a >= 'a' && *a <= 'z') *a += 'A' - 'a';
    734:     a++;
    735:   }
    736:   return(0);
    737: }

    739: /*@C
    740:    PetscStrendswith - Determines if a string ends with a certain string

    742:    Not Collective

    744:    Input Parameters:
    745: +  a - pointer to string
    746: -  b - string to endwith

    748:    Output Parameter:
    749: .  flg - PETSC_TRUE or PETSC_FALSE

    751:    Notes:
    752:     Not for use in Fortran

    754:    Level: intermediate

    756: @*/
    757: PetscErrorCode  PetscStrendswith(const char a[],const char b[],PetscBool *flg)
    758: {
    759:   char           *test;
    761:   size_t         na,nb;

    764:   *flg = PETSC_FALSE;
    765:   PetscStrrstr(a,b,&test);
    766:   if (test) {
    767:     PetscStrlen(a,&na);
    768:     PetscStrlen(b,&nb);
    769:     if (a+na-nb == test) *flg = PETSC_TRUE;
    770:   }
    771:   return(0);
    772: }

    774: /*@C
    775:    PetscStrbeginswith - Determines if a string begins with a certain string

    777:    Not Collective

    779:    Input Parameters:
    780: +  a - pointer to string
    781: -  b - string to begin with

    783:    Output Parameter:
    784: .  flg - PETSC_TRUE or PETSC_FALSE

    786:    Notes:
    787:     Not for use in Fortran

    789:    Level: intermediate

    791: .seealso: PetscStrendswithwhich(), PetscStrendswith(), PetscStrtoupper, PetscStrtolower(), PetscStrrchr(), PetscStrchr(),
    792:           PetscStrncmp(), PetscStrlen(), PetscStrncmp(), PetscStrcmp()

    794: @*/
    795: PetscErrorCode  PetscStrbeginswith(const char a[],const char b[],PetscBool *flg)
    796: {
    797:   char           *test;

    801:   *flg = PETSC_FALSE;
    802:   PetscStrrstr(a,b,&test);
    803:   if (test && (test == a)) *flg = PETSC_TRUE;
    804:   return(0);
    805: }

    808: /*@C
    809:    PetscStrendswithwhich - Determines if a string ends with one of several possible strings

    811:    Not Collective

    813:    Input Parameters:
    814: +  a - pointer to string
    815: -  bs - strings to end with (last entry must be NULL)

    817:    Output Parameter:
    818: .  cnt - the index of the string it ends with or the index of NULL

    820:    Notes:
    821:     Not for use in Fortran

    823:    Level: intermediate

    825: @*/
    826: PetscErrorCode  PetscStrendswithwhich(const char a[],const char *const *bs,PetscInt *cnt)
    827: {
    828:   PetscBool      flg;

    832:   *cnt = 0;
    833:   while (bs[*cnt]) {
    834:     PetscStrendswith(a,bs[*cnt],&flg);
    835:     if (flg) return(0);
    836:     *cnt += 1;
    837:   }
    838:   return(0);
    839: }

    841: /*@C
    842:    PetscStrrstr - Locates last occurance of string in another string

    844:    Not Collective

    846:    Input Parameters:
    847: +  a - pointer to string
    848: -  b - string to find

    850:    Output Parameter:
    851: .  tmp - location of occurance

    853:    Notes:
    854:     Not for use in Fortran

    856:    Level: intermediate

    858: @*/
    859: PetscErrorCode  PetscStrrstr(const char a[],const char b[],char *tmp[])
    860: {
    861:   const char *stmp = a, *ltmp = NULL;

    864:   while (stmp) {
    865:     stmp = (char*)strstr(stmp,b);
    866:     if (stmp) {ltmp = stmp;stmp++;}
    867:   }
    868:   *tmp = (char*)ltmp;
    869:   return(0);
    870: }

    872: /*@C
    873:    PetscStrstr - Locates first occurance of string in another string

    875:    Not Collective

    877:    Input Parameters:
    878: +  haystack - string to search
    879: -  needle - string to find

    881:    Output Parameter:
    882: .  tmp - location of occurance, is a NULL if the string is not found

    884:    Notes:
    885:     Not for use in Fortran

    887:    Level: intermediate

    889: @*/
    890: PetscErrorCode  PetscStrstr(const char haystack[],const char needle[],char *tmp[])
    891: {
    893:   *tmp = (char*)strstr(haystack,needle);
    894:   return(0);
    895: }

    897: struct _p_PetscToken {char token;char *array;char *current;};

    899: /*@C
    900:    PetscTokenFind - Locates next "token" in a string

    902:    Not Collective

    904:    Input Parameters:
    905: .  a - pointer to token

    907:    Output Parameter:
    908: .  result - location of occurance, NULL if not found

    910:    Notes:

    912:      This version is different from the system version in that
    913:   it allows you to pass a read-only string into the function.

    915:      This version also treats all characters etc. inside a double quote "
    916:    as a single token.

    918:      For example if the separator character is + and the string is xxxx+y then the first fine will return a pointer to a null terminated xxxx and the
    919:    second will return a null terminated y

    921:      If the separator character is + and the string is xxxx then the first and only token found will be a pointer to a null terminated xxxx

    923:     Not for use in Fortran

    925:    Level: intermediate

    928: .seealso: PetscTokenCreate(), PetscTokenDestroy()
    929: @*/
    930: PetscErrorCode  PetscTokenFind(PetscToken a,char *result[])
    931: {
    932:   char *ptr = a->current,token;

    935:   *result = a->current;
    936:   if (ptr && !*ptr) {*result = NULL; return(0);}
    937:   token = a->token;
    938:   if (ptr && (*ptr == '"')) {token = '"';(*result)++;ptr++;}
    939:   while (ptr) {
    940:     if (*ptr == token) {
    941:       *ptr++ = 0;
    942:       while (*ptr == a->token) ptr++;
    943:       a->current = ptr;
    944:       break;
    945:     }
    946:     if (!*ptr) {
    947:       a->current = NULL;
    948:       break;
    949:     }
    950:     ptr++;
    951:   }
    952:   return(0);
    953: }

    955: /*@C
    956:    PetscTokenCreate - Creates a PetscToken used to find tokens in a string

    958:    Not Collective

    960:    Input Parameters:
    961: +  string - the string to look in
    962: -  b - the separator character

    964:    Output Parameter:
    965: .  t- the token object

    967:    Notes:

    969:      This version is different from the system version in that
    970:   it allows you to pass a read-only string into the function.

    972:     Not for use in Fortran

    974:    Level: intermediate

    976: .seealso: PetscTokenFind(), PetscTokenDestroy()
    977: @*/
    978: PetscErrorCode  PetscTokenCreate(const char a[],const char b,PetscToken *t)
    979: {

    983:   PetscNew(t);
    984:   PetscStrallocpy(a,&(*t)->array);

    986:   (*t)->current = (*t)->array;
    987:   (*t)->token   = b;
    988:   return(0);
    989: }

    991: /*@C
    992:    PetscTokenDestroy - Destroys a PetscToken

    994:    Not Collective

    996:    Input Parameters:
    997: .  a - pointer to token

    999:    Level: intermediate

    1001:    Notes:
    1002:     Not for use in Fortran

    1004: .seealso: PetscTokenCreate(), PetscTokenFind()
    1005: @*/
    1006: PetscErrorCode  PetscTokenDestroy(PetscToken *a)
    1007: {

    1011:   if (!*a) return(0);
    1012:   PetscFree((*a)->array);
    1013:   PetscFree(*a);
    1014:   return(0);
    1015: }

    1017: /*@C
    1018:    PetscStrInList - search string in character-delimited list

    1020:    Not Collective

    1022:    Input Parameters:
    1023: +  str - the string to look for
    1024: .  list - the list to search in
    1025: -  sep - the separator character

    1027:    Output Parameter:
    1028: .  found - whether str is in list

    1030:    Level: intermediate

    1032:    Notes:
    1033:     Not for use in Fortran

    1035: .seealso: PetscTokenCreate(), PetscTokenFind(), PetscStrcmp()
    1036: @*/
    1037: PetscErrorCode PetscStrInList(const char str[],const char list[],char sep,PetscBool *found)
    1038: {
    1039:   PetscToken     token;
    1040:   char           *item;

    1044:   *found = PETSC_FALSE;
    1045:   PetscTokenCreate(list,sep,&token);
    1046:   PetscTokenFind(token,&item);
    1047:   while (item) {
    1048:     PetscStrcmp(str,item,found);
    1049:     if (*found) break;
    1050:     PetscTokenFind(token,&item);
    1051:   }
    1052:   PetscTokenDestroy(&token);
    1053:   return(0);
    1054: }

    1056: /*@C
    1057:    PetscGetPetscDir - Gets the directory PETSc is installed in

    1059:    Not Collective

    1061:    Output Parameter:
    1062: .  dir - the directory

    1064:    Level: developer

    1066:    Notes:
    1067:     Not for use in Fortran

    1069: @*/
    1070: PetscErrorCode  PetscGetPetscDir(const char *dir[])
    1071: {
    1073:   *dir = PETSC_DIR;
    1074:   return(0);
    1075: }

    1077: /*@C
    1078:    PetscStrreplace - Replaces substrings in string with other substrings

    1080:    Not Collective

    1082:    Input Parameters:
    1083: +   comm - MPI_Comm of processors that are processing the string
    1084: .   aa - the string to look in
    1085: .   b - the resulting copy of a with replaced strings (b can be the same as a)
    1086: -   len - the length of b

    1088:    Notes:
    1089:       Replaces   ${PETSC_ARCH},${PETSC_DIR},${PETSC_LIB_DIR},${DISPLAY},
    1090:       ${HOMEDIRECTORY},${WORKINGDIRECTORY},${USERNAME}, ${HOSTNAME} with appropriate values
    1091:       as well as any environmental variables.

    1093:       PETSC_LIB_DIR uses the environmental variable if it exists. PETSC_ARCH and PETSC_DIR use what
    1094:       PETSc was built with and do not use environmental variables.

    1096:       Not for use in Fortran

    1098:    Level: intermediate

    1100: @*/
    1101: PetscErrorCode  PetscStrreplace(MPI_Comm comm,const char aa[],char b[],size_t len)
    1102: {
    1104:   int            i = 0;
    1105:   size_t         l,l1,l2,l3;
    1106:   char           *work,*par,*epar,env[1024],*tfree,*a = (char*)aa;
    1107:   const char     *s[] = {"${PETSC_ARCH}","${PETSC_DIR}","${PETSC_LIB_DIR}","${DISPLAY}","${HOMEDIRECTORY}","${WORKINGDIRECTORY}","${USERNAME}","${HOSTNAME}",NULL};
    1108:   char           *r[] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};
    1109:   PetscBool      flag;
    1110:   static size_t  DISPLAY_LENGTH = 265,USER_LENGTH = 256, HOST_LENGTH = 256;

    1113:   if (!a || !b) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NULL,"a and b strings must be nonnull");
    1114:   if (aa == b) {
    1115:     PetscStrallocpy(aa,(char**)&a);
    1116:   }
    1117:   PetscMalloc1(len,&work);

    1119:   /* get values for replaced variables */
    1120:   PetscStrallocpy(PETSC_ARCH,&r[0]);
    1121:   PetscStrallocpy(PETSC_DIR,&r[1]);
    1122:   PetscStrallocpy(PETSC_LIB_DIR,&r[2]);
    1123:   PetscMalloc1(DISPLAY_LENGTH,&r[3]);
    1124:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[4]);
    1125:   PetscMalloc1(PETSC_MAX_PATH_LEN,&r[5]);
    1126:   PetscMalloc1(USER_LENGTH,&r[6]);
    1127:   PetscMalloc1(HOST_LENGTH,&r[7]);
    1128:   PetscGetDisplay(r[3],DISPLAY_LENGTH);
    1129:   PetscGetHomeDirectory(r[4],PETSC_MAX_PATH_LEN);
    1130:   PetscGetWorkingDirectory(r[5],PETSC_MAX_PATH_LEN);
    1131:   PetscGetUserName(r[6],USER_LENGTH);
    1132:   PetscGetHostName(r[7],HOST_LENGTH);

    1134:   /* replace that are in environment */
    1135:   PetscOptionsGetenv(comm,"PETSC_LIB_DIR",env,sizeof(env),&flag);
    1136:   if (flag) {
    1137:     PetscFree(r[2]);
    1138:     PetscStrallocpy(env,&r[2]);
    1139:   }

    1141:   /* replace the requested strings */
    1142:   PetscStrncpy(b,a,len);
    1143:   while (s[i]) {
    1144:     PetscStrlen(s[i],&l);
    1145:     PetscStrstr(b,s[i],&par);
    1146:     while (par) {
    1147:       *par =  0;
    1148:       par += l;

    1150:       PetscStrlen(b,&l1);
    1151:       PetscStrlen(r[i],&l2);
    1152:       PetscStrlen(par,&l3);
    1153:       if (l1 + l2 + l3 >= len) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"b len is not long enough to hold new values");
    1154:       PetscStrncpy(work,b,len);
    1155:       PetscStrlcat(work,r[i],len);
    1156:       PetscStrlcat(work,par,len);
    1157:       PetscStrncpy(b,work,len);
    1158:       PetscStrstr(b,s[i],&par);
    1159:     }
    1160:     i++;
    1161:   }
    1162:   i = 0;
    1163:   while (r[i]) {
    1164:     tfree = (char*)r[i];
    1165:     PetscFree(tfree);
    1166:     i++;
    1167:   }

    1169:   /* look for any other ${xxx} strings to replace from environmental variables */
    1170:   PetscStrstr(b,"${",&par);
    1171:   while (par) {
    1172:     *par  = 0;
    1173:     par  += 2;
    1174:     PetscStrncpy(work,b,len);
    1175:     PetscStrstr(par,"}",&epar);
    1176:     *epar = 0;
    1177:     epar += 1;
    1178:     PetscOptionsGetenv(comm,par,env,sizeof(env),&flag);
    1179:     if (!flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Substitution string ${%s} not found as environmental variable",par);
    1180:     PetscStrlcat(work,env,len);
    1181:     PetscStrlcat(work,epar,len);
    1182:     PetscStrncpy(b,work,len);
    1183:     PetscStrstr(b,"${",&par);
    1184:   }
    1185:   PetscFree(work);
    1186:   if (aa == b) {
    1187:     PetscFree(a);
    1188:   }
    1189:   return(0);
    1190: }

    1192: /*@C
    1193:    PetscEListFind - searches list of strings for given string, using case insensitive matching

    1195:    Not Collective

    1197:    Input Parameters:
    1198: +  n - number of strings in
    1199: .  list - list of strings to search
    1200: -  str - string to look for, empty string "" accepts default (first entry in list)

    1202:    Output Parameters:
    1203: +  value - index of matching string (if found)
    1204: -  found - boolean indicating whether string was found (can be NULL)

    1206:    Notes:
    1207:    Not for use in Fortran

    1209:    Level: advanced
    1210: @*/
    1211: PetscErrorCode PetscEListFind(PetscInt n,const char *const *list,const char *str,PetscInt *value,PetscBool *found)
    1212: {
    1214:   PetscBool matched;
    1215:   PetscInt i;

    1218:   if (found) *found = PETSC_FALSE;
    1219:   for (i=0; i<n; i++) {
    1220:     PetscStrcasecmp(str,list[i],&matched);
    1221:     if (matched || !str[0]) {
    1222:       if (found) *found = PETSC_TRUE;
    1223:       *value = i;
    1224:       break;
    1225:     }
    1226:   }
    1227:   return(0);
    1228: }

    1230: /*@C
    1231:    PetscEnumFind - searches enum list of strings for given string, using case insensitive matching

    1233:    Not Collective

    1235:    Input Parameters:
    1236: +  enumlist - list of strings to search, followed by enum name, then enum prefix, then NUL
    1237: -  str - string to look for

    1239:    Output Parameters:
    1240: +  value - index of matching string (if found)
    1241: -  found - boolean indicating whether string was found (can be NULL)

    1243:    Notes:
    1244:    Not for use in Fortran

    1246:    Level: advanced
    1247: @*/
    1248: PetscErrorCode PetscEnumFind(const char *const *enumlist,const char *str,PetscEnum *value,PetscBool *found)
    1249: {
    1251:   PetscInt n = 0,evalue;
    1252:   PetscBool efound;

    1255:   while (enumlist[n++]) if (n > 50) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument appears to be wrong or have more than 50 entries");
    1256:   if (n < 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"List argument must have at least two entries: typename and type prefix");
    1257:   n -= 3; /* drop enum name, prefix, and null termination */
    1258:   PetscEListFind(n,enumlist,str,&evalue,&efound);
    1259:   if (efound) *value = (PetscEnum)evalue;
    1260:   if (found) *found = efound;
    1261:   return(0);
    1262: }