basename Function

  1. stringifor_string_t.F90
  2. stringifor_string_t
  3. basename

private elemental function basename(self, sep, extension, strip_last_extension)

Arguments

Type IntentOptional AttributesName
class(string), intent(in) :: self

The string.
character(kind=CK,len=*), intent(in), optional :: sep

Directory separator.
character(kind=CK,len=*), intent(in), optional :: extension

File extension.
logical, intent(in), optional :: strip_last_extension

Flag to enable the stripping of last extension.

Return Value type(string)

Base file name.

Description

Return the base file name of a string containing a file name.

Optionally, the extension is also stripped if provided or the last one if required, e.g.

Example

 type(string) :: astring
 astring = 'bar/foo.tar.bz2'
 print '(A)', astring%basename(extension='.tar.bz2')//''        ! print "foo"
 print '(A)', astring%basename(strip_last_extension=.true.)//'' ! print "foo.tar"

Variables

TypeVisibility AttributesNameInitial
character(kind=CK,len=:), public, allocatable:: sep_

Separator, default value.
integer, public :: pos

Character position.
character(kind=CK,len=:), public, allocatable:: temporary

Temporary storage, workaround for GNU bug.

Source Code

  elemental function basename(self, sep, extension, strip_last_extension)
  !---------------------------------------------------------------------------------------------------------------------------------
  !< Return the base file name of a string containing a file name.
  !<
  !< Optionally, the extension is also stripped if provided or the last one if required, e.g.
  !<
  !<### Example
  !<
  !<```fortran
  !< type(string) :: astring
  !< astring = 'bar/foo.tar.bz2'
  !< print '(A)', astring%basename(extension='.tar.bz2')//''        ! print "foo"
  !< print '(A)', astring%basename(strip_last_extension=.true.)//'' ! print "foo.tar"
  !<```
  !---------------------------------------------------------------------------------------------------------------------------------
  class(string),             intent(in)           :: self                 !< The string.
  character(kind=CK, len=*), intent(in), optional :: sep                  !< Directory separator.
  character(kind=CK, len=*), intent(in), optional :: extension            !< File extension.
  logical,                   intent(in), optional :: strip_last_extension !< Flag to enable the stripping of last extension.
  type(string)                                    :: basename             !< Base file name.
  character(kind=CK, len=:), allocatable          :: sep_                 !< Separator, default value.
  integer                                         :: pos                  !< Character position.
#ifdef __GFORTRAN__
  character(kind=CK, len=:), allocatable          :: temporary            !< Temporary storage, workaround for GNU bug.
#endif
  !---------------------------------------------------------------------------------------------------------------------------------

  !---------------------------------------------------------------------------------------------------------------------------------
  if (allocated(self%raw)) then
    sep_ = UIX_DIR_SEP ; if (present(sep)) sep_ = sep
    basename = self
#ifdef __GFORTRAN__
    temporary = basename%raw
    pos = index(temporary, sep_, back=.true.)
    if (pos>0) basename%raw = temporary(pos+1:)
#else
    pos = index(basename%raw, sep_, back=.true.)
    if (pos>0) basename%raw = self%raw(pos+1:)
#endif
    if (present(extension)) then
#ifdef __GFORTRAN__
      temporary = basename%raw
      pos = index(temporary, extension, back=.true.)
      if (pos>0) basename%raw = temporary(1:pos-1)
#else
      pos = index(basename%raw, extension, back=.true.)
      if (pos>0) basename%raw = basename%raw(1:pos-1)
#endif
    elseif (present(strip_last_extension)) then
      if (strip_last_extension) then
#ifdef __GFORTRAN__
        temporary = basename%raw
        pos = index(temporary, '.', back=.true.)
        basename%raw = temporary(1:pos-1)
#else
        pos = index(basename%raw, '.', back=.true.)
        basename%raw = basename%raw(1:pos-1)
#endif
      endif
    endif
  endif
  return
  !---------------------------------------------------------------------------------------------------------------------------------
  endfunction basename