Intermediate checkin - working code

Makefile

@@ -18,7 +18,8 @@ OBJFILES = ${OBJDIR}/student_m.o \
 	${OBJDIR}/student_json_m.o ${OBJDIR}/student_xml_m.o \
 	${OBJDIR}/http_request_m.o ${OBJDIR}/url_helper.o \
 	${OBJDIR}/string_utils.o ${OBJDIR}/json_parser_m.o \
-	${OBJDIR}/object_parser_m.o ${OBJDIR}/xml_parser_m.o
+	${OBJDIR}/object_parser_m.o ${OBJDIR}/xml_parser_m.o \
+	${OBJDIR}/attribute_value_pair_m.o
 
 cgi/api.cgi:	${LIBDIR}/libfsqlite.a ${OBJFILES}
 	${FORTRAN} -J${MODDIR} -o cgi/api.cgi api.f90 ${OBJFILES} \
@@ -30,7 +31,11 @@ ${OBJDIR}/api_errors.o:	api_errors.f90 ${OBJDIR}/http_response_m.o
 ${OBJDIR}/string_utils.o:	string_utils.f90
 	${FORTRAN} ${FCFLAGS} -o ${OBJDIR}/string_utils.o string_utils.f90
 
-${OBJDIR}/url_helper.o:	url_helper.f90
+${OBJDIR}/attribute_value_pair_m.o:	attribute_value_pair_m.f90
+	${FORTRAN} ${FCFLAGS} -o ${OBJDIR}/attribute_value_pair_m.o \
+			attribute_value_pair_m.f90
+
+${OBJDIR}/url_helper.o:	${OBJDIR}/attribute_value_pair_m.o url_helper.f90
 	${FORTRAN} ${FCFLAGS} -o ${OBJDIR}/url_helper.o url_helper.f90
 
 ${OBJDIR}/student_collection_m.o:	${OBJDIR}/student_m.o \

api.f90

@@ -1,4 +1,5 @@
 program api
+    use attribute_value_pair_m
     use student_collection_m
     use student_json_m
     use student_xml_m

attribute_value_pair_m.f90

@@ -0,0 +1,12 @@
+module attribute_value_pair_m
+    implicit none
+    private
+
+    type, public :: attribute_value_pair_t
+        character(len=80) :: the_attribute
+        character(len=80) :: the_value
+    end type attribute_value_pair_t
+
+contains
+
+end module attribute_value_pair_m

http_request_m.f90

@@ -1,4 +1,5 @@
 module http_request_m
+    use attribute_value_pair_m
     use string_utils
     use url_helper
 

json_parser_m.f90

@@ -8,28 +8,76 @@ module json_parser_m
         private
 
         contains
-            procedure, public, pass(this) :: parse, &
-                                             process_object, &
-                                             process_attribute_value_pair, &
-                                             process_error
+            procedure, public, pass(this) :: parse
 
     end type json_parser_t
 
 contains
-    subroutine parse(this)
+    subroutine parse(this, raw_data)
         class(json_parser_t), intent(inout) :: this
-    end subroutine parse
+        character(len=*), intent(in) :: raw_data
 
-    subroutine process_object(this)
-        class(json_parser_t), intent(inout) :: this
-    end subroutine process_object
+        integer :: i, current_pos, str_pos
 
-    subroutine process_attribute_value_pair(this)
-        class(json_parser_t), intent(inout) :: this
-    end subroutine process_attribute_value_pair
+        this%error_m = .false.
+        this%error_string_m = ''
+        this%raw_data_m = raw_data
+        this%parsing_attribute_value_pair_m = .false.
+        this%parsing_attribute_m = .false.
+        this%parsing_value_m = .false.
+        this%object_depth_m = 0
 
-    subroutine process_error(this)
-        class(json_parser_t), intent(inout) :: this
-    end subroutine process_error
+        do i=1,len_trim(raw_data)
+            if (raw_data(i:i) == '{') then
+                this%object_depth_m = this%object_depth_m + 1
+            else if (raw_data(i:i) == '}') then
+                this%object_depth_m = this%object_depth_m - 1
+                if (this%object_depth_m < 0) then
+                    call this%process_error('Unbalanced curly braces')
+                    exit
+                end if
+            else if (raw_data(i:i) == '"' .or. raw_data(i:i) == "'") then
+                if (.not. this%parsing_attribute_m .and. &
+                    .not. this%parsing_value_m .and. &
+                    .not. this%parsing_attribute_value_pair_m) then
+                    this%parsing_attribute_m = .true.
+                    this%parsing_attribute_value_pair_m = .true.
+                    str_pos = 0
+                else if (this%parsing_attribute_m .and. &
+                         .not. this%parsing_value_m .and. &
+                         this%parsing_attribute_value_pair_m) then
+                    this%parsing_attribute_m = .false.
+                else if (.not. this%parsing_attribute_m .and. &
+                         .not. this%parsing_value_m .and. &
+                         this%parsing_attribute_value_pair_m) then
+                    this%parsing_value_m = .true.
+                    str_pos = 0
+                else if (.not. this%parsing_attribute_m .and. &
+                         this%parsing_value_m .and. &
+                         this%parsing_attribute_value_pair_m) then
+                    this%parsing_value_m = .false.
+                    this%parsing_attribute_value_pair_m = .false.
+                else
+                    call this%process_error('Unablanced quotes')
+                    exit
+                end if
+            else
+                if (this%parsing_attribute_m) then
+                    call this%add_attribute_value_pair()
+                    current_pos = size(this%attribute_value_pairs_m)
+
+                    this%attribute_value_pairs_m(current_pos)% &
+                        the_attribute(str_pos:str_pos) = raw_data(i:i)
+                    str_pos = str_pos + 1
+                else if (this%parsing_value_m) then
+                    current_pos = size(this%attribute_value_pairs_m)
+
+                    this%attribute_value_pairs_m(current_pos)% &
+                        the_value(str_pos:str_pos) = raw_data(i:i)
+                    str_pos = str_pos + 1
+                end if 
+            end if
+        end do
+    end subroutine parse
 
 end module json_parser_m

object_parser_m.f90

@@ -1,33 +1,68 @@
 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_object, &
-                                             process_attribute_value_pair, &
-                                             process_error
+                                             process_error, &
+                                             add_attribute_value_pair
 
     end type object_parser_t
 
 contains
-    subroutine parse(this)
+    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_object(this)
+    subroutine process_error(this, error_str)
         class(object_parser_t), intent(inout) :: this
-    end subroutine process_object
+        character(len=*), intent(in) :: error_str
 
-    subroutine process_attribute_value_pair(this)
-        class(object_parser_t), intent(inout) :: this
-    end subroutine process_attribute_value_pair
+        this%error_m = .true.
+        this%error_string_m = error_str
+    end subroutine process_error
 
-    subroutine process_error(this)
+    subroutine add_attribute_value_pair(this)
         class(object_parser_t), intent(inout) :: this
-    end subroutine process_error
+
+        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)
+            this%attribute_value_pairs_m = 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

url_helper.f90

@@ -1,12 +1,9 @@
 module url_helper
+    use attribute_value_pair_m
+
     implicit none
     private
 
-    type, public :: attribute_value_pair_t
-        character(len=80) :: the_attribute
-        character(len=80) :: the_value
-    end type attribute_value_pair_t
-
     public :: get_num_uri_elements, &
               split_path, &
               get_num_attributes, &

xml_parser_m.f90

@@ -8,28 +8,16 @@ module xml_parser_m
         private
 
         contains
-            procedure, public, pass(this) :: parse, &
-                                             process_object, &
-                                             process_attribute_value_pair, &
-                                             process_error
+            procedure, public, pass(this) :: parse
 
     end type xml_parser_t
 
 contains
-    subroutine parse(this)
+    subroutine parse(this, raw_data)
         class(xml_parser_t), intent(inout) :: this
-    end subroutine parse
-
-    subroutine process_object(this)
-        class(xml_parser_t), intent(inout) :: this
-    end subroutine process_object
+        character(len=*), intent(in) :: raw_data
 
-    subroutine process_attribute_value_pair(this)
-        class(xml_parser_t), intent(inout) :: this
-    end subroutine process_attribute_value_pair
-
-    subroutine process_error(this)
-        class(xml_parser_t), intent(inout) :: this
-    end subroutine process_error
+        this%raw_data_m = raw_data
+    end subroutine parse
 
 end module xml_parser_m