off_os_object.f90 Source File

OFF OS object definition and implementation.

This File Depends On

sourcefile~~off_os_object.f90~~EfferentGraph sourcefile~off_os_object.f90 off_os_object.f90 sourcefile~off_error_object.f90 off_error_object.f90 sourcefile~off_error_object.f90->sourcefile~off_os_object.f90
Help

Files Dependent On This One

sourcefile~~off_os_object.f90~~AfferentGraph sourcefile~off_os_object.f90 off_os_object.f90 sourcefile~off_objects.f90 off_objects.f90 sourcefile~off_os_object.f90->sourcefile~off_objects.f90 sourcefile~off_simulation_object.f90 off_simulation_object.f90 sourcefile~off_os_object.f90->sourcefile~off_simulation_object.f90 sourcefile~off_test_save_load_file_grid.f90 off_test_save_load_file_grid.f90 sourcefile~off_objects.f90->sourcefile~off_test_save_load_file_grid.f90 sourcefile~off_test_load_file_parameters.f90 off_test_load_file_parameters.f90 sourcefile~off_objects.f90->sourcefile~off_test_load_file_parameters.f90 sourcefile~off_test_save_load_file_parameters.f90 off_test_save_load_file_parameters.f90 sourcefile~off_objects.f90->sourcefile~off_test_save_load_file_parameters.f90 sourcefile~off_simulation_object.f90->sourcefile~off_objects.f90
Help

Source Code


Source Code

!< OFF OS object definition and implementation.

module off_os_object
!< OFF OS object definition and implementation.

use off_error_object, only : error_object
use penf, only : I4P
use stringifor, only : string

implicit none
private
public :: os_object

integer(I4P), parameter :: NO_ERROR            = 0 !< No errors occurred.
integer(I4P), parameter :: ERROR_CP_FAILED     = 1 !< Failed to copy files/directories.
integer(I4P), parameter :: ERROR_MKDIR_FAILED  = 2 !< Failed to create directory.
integer(I4P), parameter :: ERROR_RM_FAILED     = 3 !< Failed to remove files/directories.
integer(I4P), parameter :: ERROR_FALLBACK_INIT = 4 !< Failed to set custom OS, used fallback system (unix).

type :: os_object
   !< OS object class.
   !<
   !< This class is designed as an helper for performing system calls, e.g. make directory, copy files, etc...
   type(error_object)            :: error           !< Error handler.
   character(len=:), allocatable :: path_separator  !< Path seperator, e.g. "/" for unix-like systems.
   character(len=:), allocatable :: cp_dir_command  !< Copy directory command.
   character(len=:), allocatable :: cp_file_command !< Copy file command.
   character(len=:), allocatable :: mkdir_command   !< Make directory command.
   character(len=:), allocatable :: rm_dir_command  !< Remove directory command.
   character(len=:), allocatable :: rm_file_command !< Remove file command.
   contains
      ! public methods
      procedure, pass(self) :: cp         !< Copy files/directories.
      procedure, pass(self) :: destroy    !< Destroy OS... not your :-)
      procedure, pass(self) :: initialize !< Initialze OS.
      procedure, pass(self) :: mkdir      !< Make directory.
      procedure, pass(self) :: rm         !< Remove files/directories.
      ! operators
      generic :: assignment(=) => os_assign_os !< Overload `=`.
      ! private methods
      procedure, pass(self) :: initialize_unix    !< Initialze OS as unix-like system.
      procedure, pass(self) :: initialize_windows !< Initialze OS as windows-like system.
      procedure, pass(lhs)  :: os_assign_os       !< Operator `=`.
endtype os_object

contains
  ! public methods
  subroutine cp(self, file_name, dir_name)
  !< Copy files/directories.
  !<
  !< @note leading and trailing white spaces are trimmed out.
  class(os_object), intent(inout)        :: self      !< OS.
  character(*),     intent(in), optional :: file_name !< File name.
  character(*),     intent(in), optional :: dir_name  !< Dir name.

  if (present(file_name)) then
     call execute_command_line(command=self%cp_file_command//' '//trim(adjustl(file_name)), exitstat=self%error%status)
  elseif (present(dir_name)) then
     call execute_command_line(command=self%cp_dir_command//' '//trim(adjustl(dir_name)), exitstat=self%error%status)
  else
     self%error%status = ERROR_CP_FAILED
  endif
  endsubroutine cp

  elemental subroutine destroy(self)
  !< Destroy OS... not your :-)
  class(os_object), intent(inout) :: self  !< OS.
  type(os_object)                 :: fresh !< Fresh instance of OS.

  self = fresh
  if (allocated(self%path_separator))  deallocate(self%path_separator)
  if (allocated(self%cp_dir_command))  deallocate(self%cp_dir_command)
  if (allocated(self%cp_file_command)) deallocate(self%cp_file_command)
  if (allocated(self%mkdir_command))   deallocate(self%mkdir_command)
  if (allocated(self%rm_dir_command))  deallocate(self%rm_dir_command)
  if (allocated(self%rm_file_command)) deallocate(self%rm_file_command)
  endsubroutine destroy

  elemental subroutine initialize(self, system)
  !< Initialize OS.
  class(os_object), intent(inout)        :: self    !< OS.
  character(*),     intent(in), optional :: system  !< System name, valid [unix, windows].
  type(string)                           :: system_ !< System name.

  self%error%status = 0
  system_ = 'UNIX'
  if (present(system)) then
     system_ = trim(adjustl(system))
     system_ = system_%upper()
  endif
  select case(system_%chars())
  case('UNIX')
     call self%initialize_unix
  case('WINDOWS')
     call self%initialize_windows
  case default
     call self%initialize_unix
     self%error%status = ERROR_FALLBACK_INIT
  endselect
  endsubroutine initialize

  subroutine mkdir(self, dir_name)
  !< Make directoriy.
  !<
  !< @note leading and trailing white spaces are trimmed out.
  class(os_object), intent(inout) :: self     !< OS.
  character(*),     intent(in)    :: dir_name !< Dir name.

  call execute_command_line(command=self%mkdir_command//' '//trim(adjustl(dir_name)), exitstat=self%error%status)
  endsubroutine mkdir

  subroutine rm(self, file_name, dir_name)
  !< Remove files/directories.
  !<
  !< @note leading and trailing white spaces are trimmed out.
  class(os_object), intent(inout)        :: self      !< OS.
  character(*),     intent(in), optional :: file_name !< File name.
  character(*),     intent(in), optional :: dir_name  !< Dir name.

  if (present(file_name)) then
     call execute_command_line(command=self%rm_file_command//' '//trim(adjustl(file_name)), exitstat=self%error%status)
  elseif (present(dir_name)) then
     call execute_command_line(command=self%rm_dir_command//' '//trim(adjustl(dir_name)), exitstat=self%error%status)
  else
     self%error%status = ERROR_RM_FAILED
  endif
  endsubroutine rm

  ! private methods
  elemental subroutine initialize_unix(self)
  !< Initialize OS as unix-like system.
  class(os_object), intent(inout) :: self !< OS.

  call self%destroy
  self%path_separator  = char(47)
  self%cp_dir_command  = 'cp -r'
  self%cp_file_command = 'cp'
  self%mkdir_command   = 'mkdir -p'
  self%rm_dir_command  = 'rm -fr'
  self%rm_file_command = 'rm -f'
  endsubroutine initialize_unix

  elemental subroutine initialize_windows(self)
  !< Initialize OS as windows-like system.
  class(os_object), intent(inout) :: self !< OS.

  call self%destroy
  self%path_separator  = char(92)
  self%cp_dir_command  = 'copy'
  self%cp_file_command = 'copy'
  self%mkdir_command   = 'mkdir'
  self%rm_dir_command  = 'del'
  self%rm_file_command = 'del'
  endsubroutine initialize_windows

   pure subroutine os_assign_os(lhs, rhs)
   !< Operator `=`.
   class(os_object), intent(inout) :: lhs !< Left hand side.
   type(os_object),  intent(in)    :: rhs !< Right hand side.

   lhs%error = rhs%error
  if (allocated(rhs%path_separator))  lhs%path_separator  = rhs%path_separator
  if (allocated(rhs%cp_dir_command))  lhs%cp_dir_command  = rhs%cp_dir_command
  if (allocated(rhs%cp_file_command)) lhs%cp_file_command = rhs%cp_file_command
  if (allocated(rhs%mkdir_command))   lhs%mkdir_command   = rhs%mkdir_command
  if (allocated(rhs%rm_dir_command))  lhs%rm_dir_command  = rhs%rm_dir_command
  if (allocated(rhs%rm_file_command)) lhs%rm_file_command = rhs%rm_file_command
   endsubroutine os_assign_os
endmodule off_os_object