FABS/object_parser_m.f90 at master · bceverly/FABS · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
module object_parser_m
    use attribute_value_pair_m

    implicit none
    private

    type, public :: object_parser_t
        private
            character(len=4096), public :: raw_data_m
            integer, public :: object_depth_m = 0
            logical, public :: parsing_attribute_value_pair_m = .false.
            logical, public :: parsing_attribute_m = .false.
            logical, public :: parsing_value_m = .false.
            logical, public :: error_m = .false.
            character(len=4096), public :: error_string_m = ''
            type(attribute_value_pair_t), public, dimension(:), pointer :: &
                attribute_value_pairs_m

        contains
            procedure, public, pass(this) :: parse, &
                                             process_error, &
                                             add_attribute_value_pair

    end type object_parser_t

contains
    subroutine parse(this, raw_data)
        class(object_parser_t), intent(inout) :: this
        character(len=*), intent(in) :: raw_data

        this%error_m = .false.
        this%error_string_m = ''
        this%raw_data_m = raw_data
    end subroutine parse

    subroutine process_error(this, error_str)
        class(object_parser_t), intent(inout) :: this
        character(len=*), intent(in) :: error_str

        this%error_m = .true.
        this%error_string_m = error_str
    end subroutine process_error

    subroutine add_attribute_value_pair(this)
        class(object_parser_t), intent(inout) :: this

        type(attribute_value_pair_t), pointer, dimension(:) :: temp_array
        integer :: the_size

        if (.not. associated(this%attribute_value_pairs_m)) then
            ! adding first one
            allocate(this%attribute_value_pairs_m(1))
            this%attribute_value_pairs_m(1)%the_attribute = ''
            this%attribute_value_pairs_m(1)%the_value = ''
        else
            ! adding second or subsequent on
            the_size = size(this%attribute_value_pairs_m)
            allocate(temp_array(the_size+1))
            temp_array = this%attribute_value_pairs_m
            deallocate(this%attribute_value_pairs_m)
            allocate(this%attribute_value_pairs_m(the_size+1))
            this%attribute_value_pairs_m = temp_array
            deallocate(temp_array)

            this%attribute_value_pairs_m(the_size+1)%the_attribute = ''
            this%attribute_value_pairs_m(the_size+1)%the_value = ''
        end if
    end subroutine add_attribute_value_pair

end module object_parser_m