From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.4 required=5.0 tests=BAYES_00,SUBJ_ALL_CAPS autolearn=no autolearn_force=no version=3.4.4 X-Google-Thread: 103376,ade59281d0eea302 X-Google-Attributes: gid103376,public X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news1.google.com!postnews.google.com!b75g2000hsg.googlegroups.com!not-for-mail From: "andrew.carroll@okstate.edu" Newsgroups: comp.lang.ada Subject: Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW Date: 2 Apr 2007 07:11:50 -0700 Organization: http://groups.google.com Message-ID: <1175523110.139336.101840@b75g2000hsg.googlegroups.com> References: <1175494388.509572.267790@l77g2000hsb.googlegroups.com> NNTP-Posting-Host: 139.78.128.110 Mime-Version: 1.0 Content-Type: text/plain; charset="iso-8859-1" X-Trace: posting.google.com 1175523112 10998 127.0.0.1 (2 Apr 2007 14:11:52 GMT) X-Complaints-To: groups-abuse@google.com NNTP-Posting-Date: Mon, 2 Apr 2007 14:11:52 +0000 (UTC) In-Reply-To: User-Agent: G2/1.0 X-HTTP-UserAgent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; InfoPath.1; .NET CLR 1.1.4322),gzip(gfe),gzip(gfe) Complaints-To: groups-abuse@google.com Injection-Info: b75g2000hsg.googlegroups.com; posting-host=139.78.128.110; posting-account=Kq9unQ0AAADh_grEViI3JGqegXKDDjxt Xref: g2news1.google.com comp.lang.ada:14739 Date: 2007-04-02T07:11:50-07:00 List-Id: All the files are below. The last file in the list, called tables.txt, is the input file. I've supplied the input file I am using when I get the errors. with Ada.Text_IO, Ada.Directories, GNAT.Calendar.Time_IO, Ada.Characters.Latin_1, Ada.IO_Exceptions, Ada.Strings.Maps.Constants, Ada.Strings.Fixed, Ada.Characters.Handling, Ada.Calendar, schema_types, attribute_types, parser, util, index_types; use parser, GNAT.Calendar.Time_IO, Ada.Characters.Latin_1, Ada.Strings.Maps.Constants, Ada.Strings.Fixed, Ada.Characters.Handling, Ada.Calendar, schema_types, attribute_types, util; procedure dbprog is -- the input file contains the table specifications -- input : Ada.Text_IO.File_Type; ------------------------------------ -- Variables for Processing -- ------------------------------------ char : Character; line : string_ptr; tablename : string_ptr; datacols : string_array_ptr; pkcols : string_array_ptr; schemas : schema_array_ptr; sindex : Integer := 1; tupls : tuple_ptr; procedure showoptionsmenu is begin cls; pl ("---------------------------------------------------", True); pl ("Type one of the following at the prompt:", True); pl (" ", True); pl ("~ QUIT ", True); pl ("1 INSERT DATA", True); pl ("2 UPDATE DATA", True); pl ("3 DELETE DATA", True); pl ("4 SHOW RECORDS", True); pl ("For help type 'help'", True); pl ("---------------------------------------------------", True); pl (">>", False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); end showoptionsmenu; function markschema return Integer is idx : Integer := 0; begin --find the schema in schemas. if schemas'length <= 0 then return idx; end if; loop idx := idx + 1; exit when idx > schemas'length or else Index (To_Upper (schemas (idx).tablename), tablename.all) > 0; end loop; return idx; end markschema; procedure getcolumnnamesandvalues is year : Year_Number; month : Month_Number; day : Day_Number; line : string_ptr := new String'(""); valid : Boolean := False; begin --markschema sets sindex to the appropriate index in schemas --for the table with tablename. sindex := markschema; --tables are already loaded and ready to go. datacols := new string_array (1 .. schemas (sindex).attributes'length); for x in 1 .. schemas (sindex).attributes'length loop if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "DATE" then while not valid loop pl ("Enter a YEAR (1901 - 2099) for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Year_Number'range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; year := Year_Number'value (line.all); valid := False; while not valid loop pl ("Enter a MONTH NUMBER for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Month_Number'range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; month := Month_Number'value (line.all); valid := False; while not valid loop pl ("Enter a DAY NUMBER for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Day_Number'range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; day := Day_Number'value (line.all); datacols.all (x) := new String'(Image (Time_Of (year, month, day), ISO_Date)); valid := False; else while not valid loop pl ("Enter a value for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & "(" & Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) & ") >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then if To_Upper (line.all) = "TRUE" then line := new String'("True"); valid := True; elsif To_Upper (line.all) = "FALSE" then line := new String'("False"); valid := True; elsif line.all = "1" then line := new String'("True"); valid := True; elsif line.all = "0" then line := new String'("False"); valid := True; else pl ("!! INVALID !!", True, False); end if; elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 then valid := True; else pl ("!! INVALID !!", True, False); end if; else --"STRING" valid := True; end if; end loop; valid := False; datacols.all (x) := new String'(line.all); end if; end loop; end getcolumnnamesandvalues; procedure getprimarykeynamesandvalues is year : Year_Number; month : Month_Number; day : Day_Number; line : string_ptr := new String'(""); valid : Boolean := False; begin --markschema sets sindex to the appropriate index in schemas --for the table with tablename. sindex := markschema; pl ("Provide the primary key values to identify the record to delete.", False, True); pl ("Press Enter to continue...", True, True); Ada.Text_IO.Get_Immediate (char); --tables are already loaded and ready to go. pkcols := new string_array (1 .. schemas (sindex).primary_key_count); for x in 1 .. schemas (sindex).attributes'length loop if schemas (sindex).attributes (x).isprimarykey then if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "DATE" then while not valid loop pl ("Enter a YEAR (1901 - 2099) for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Year_Number'range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; year := Year_Number'value (line.all); valid := False; while not valid loop pl ("Enter a MONTH NUMBER for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Month_Number' range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; month := Month_Number'value (line.all); valid := False; while not valid loop pl ("Enter a DAY NUMBER for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & " >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) > 0 then pl ("!! INVALID !!", True, False); elsif Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 and then Integer'value (line.all) not in Ada.Calendar.Day_Number'range then pl ("!! INVALID !!", True, False); else valid := True; end if; end loop; day := Day_Number'value (line.all); pkcols.all (x) := new String'(Image (Time_Of (year, month, day), ISO_Date)); valid := False; else while not valid loop pl ("Enter a value for " & Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both) & "(" & Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) & ") >>", False, False); while Ada.Text_IO.End_Of_Line loop Ada.Text_IO.Skip_Line; end loop; line := new String'(Ada.Text_IO.Get_Line); if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then if To_Upper (line.all) = "TRUE" then line := new String'("True"); valid := True; elsif To_Upper (line.all) = "FALSE" then line := new String'("False"); valid := True; elsif line.all = "1" then line := new String'("True"); valid := True; elsif line.all = "0" then line := new String'("False"); valid := True; else pl ("!! INVALID !!", True, False); end if; elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then if Index (line.all, Decimal_Digit_Set, Ada.Strings.Outside) <= 0 then valid := True; else pl ("!! INVALID !!", True, False); end if; else --"STRING" valid := True; end if; end loop; valid := False; pkcols.all (x) := new String'(line.all); end if; end if; end loop; end getprimarykeynamesandvalues; procedure gettablename is count : Integer := 1; begin pl ("Enter the table name in CAPITAL letters >>", False); tablename := new String'(Ada.Text_IO.Get_Line); tablename.all := To_Upper (tablename.all); while not Ada.Directories.Exists (tablename.all) and count < 5 loop pl ("Enter the table name in CAPITAL letters >>", False); tablename := new String'(Ada.Text_IO.Get_Line); tablename.all := To_Upper (tablename.all); count := count + 1; end loop; if count >= 5 then raise Constraint_Error; end if; end gettablename; procedure getchosenoptiondata is begin gettablename; --we don't do "4" here because it is just a select and we don't --need values for it and we already have the attribute names in --the schemas(sindex) object for which to SELECT or SHOW the --data. if line.all = "1" then getcolumnnamesandvalues; elsif line.all = "2" then getprimarykeynamesandvalues; pl (" ", True, True); pl ("Please enter new values for each item. You can enter the same ", True, True); pl ("data if you don't want it modified.", True, True); pl (" ", True, True); getcolumnnamesandvalues; elsif line.all = "3" then getprimarykeynamesandvalues; end if; end getchosenoptiondata; procedure parsechosenoption is pkattribs : attribute_array_ptr; newvalues : attribute_array_ptr; linelength : Integer; outline : string_ptr; begin if line.all = "1" then ------------------- -- INSERT DATA -- ------------------- newvalues := new attribute_array (1 .. schemas (sindex).attributes'length); --fill in the values on the objects and pass that to insert. for x in 1 .. newvalues'length loop if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then newvalues (x) := new booleanattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Boolean'value (datacols (x).all)); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "STRING" then newvalues (x) := new stringattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => max_stringlength * ' '); Replace_Slice (stringattribute (newvalues (x).all).value, 1, max_stringlength, datacols (x).all); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then newvalues (x) := new integerattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Integer'value (datacols (x).all)); else -- "DATE" newvalues (x) := new dateattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Value (datacols (x).all), year => Year (Value (datacols (x).all)), month => Month (Value (datacols (x).all)), day => Day (Value (datacols (x).all))); end if; end loop; insertrec (schemas (sindex).all, newvalues.all); elsif line.all = "2" then ------------------- -- UPDATE DATA -- ------------------- pkattribs := new attribute_array (1 .. pkcols'length); --fill in the values on the objects and pass that to insert. for x in 1 .. pkcols'length loop if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then pkattribs (x) := new booleanattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Boolean'value (pkcols (x).all)); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "STRING" then pkattribs (x) := new stringattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => max_stringlength * ' '); Replace_Slice (stringattribute (pkattribs (x).all).value, 1, max_stringlength, pkcols (x).all); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then pkattribs (x) := new integerattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Integer'value (pkcols (x).all)); else -- "DATE" pkattribs (x) := new dateattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Value (pkcols (x).all), year => Year (Value (pkcols (x).all)), month => Month (Value (pkcols (x).all)), day => Day (Value (pkcols (x).all))); end if; end loop; newvalues := new attribute_array (1 .. schemas (sindex).attributes'length); --fill in the values on the objects and pass that to insert. for x in 1 .. newvalues'length loop if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then newvalues (x) := new booleanattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Boolean'value (datacols (x).all)); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "STRING" then newvalues (x) := new stringattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => max_stringlength * ' '); Replace_Slice (stringattribute (newvalues (x).all).value, 1, max_stringlength, datacols (x).all); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then newvalues (x) := new integerattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Integer'value (datacols (x).all)); else -- "DATE" newvalues (x) := new dateattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Value (datacols (x).all), year => Year (Value (datacols (x).all)), month => Month (Value (datacols (x).all)), day => Day (Value (datacols (x).all))); end if; end loop; updaterec (schemas (sindex).all, pkattribs.all, newvalues.all); elsif line.all = "3" then ------------------- -- DELETE DATA -- ------------------- Ada.Text_IO.Put_Line (Integer'image (sindex)); Ada.Text_IO.Put_Line (tablename.all); pkattribs := new attribute_array (1 .. pkcols'length); --fill in the values on the objects and pass that to delete. for x in 1 .. pkcols'length loop if Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then pkattribs (x) := new booleanattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Boolean'value (pkcols (x).all)); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "STRING" then pkattribs (x) := new stringattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => max_stringlength * ' '); Replace_Slice (stringattribute (pkattribs (x).all).value, 1, max_stringlength, pkcols (x).all); elsif Trim (schemas (sindex).attributes (x).domain, Ada.Strings.Both) = "INTEGER" then pkattribs (x) := new integerattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Integer'value (pkcols (x).all)); else -- "DATE" pkattribs (x) := new dateattribute' (name => schemas (sindex).attributes (x).name, domain => schemas (sindex).attributes (x).domain, isprimarykey => schemas (sindex).attributes (x).isprimarykey, byte_start => 0, byte_end => 0, value => Value (pkcols (x).all), year => Year (Value (pkcols (x).all)), month => Month (Value (pkcols (x).all)), day => Day (Value (pkcols (x).all))); end if; end loop; deleterec (schemas (sindex).all, pkattribs.all); elsif line.all = "4" then ---------------------- -- SELECT RECORDS -- ---------------------- linelength := 60; sindex := markschema; outline := new String'(1 .. linelength => '-'); pl (outline.all, True, False); pl (schemas (sindex).tablename, True, False); pl (outline.all, True, False); pl ("| ", False, False); for x in 1 .. schemas (sindex).attributes'length loop pl (Trim (schemas (sindex).attributes (x).name, Ada.Strings.Both), False, False); if x < schemas (sindex).attributes'length then pl (" | ", False, False); end if; end loop; pl (" |", True, False); pl (outline.all, True, False); tupls := selectrec (schemas (sindex).all); if tupls = null then pl ("No Data", True, False); else for y in 1 .. tupls'length loop newvalues := tupls (y); for x in 1 .. newvalues'length loop if Trim (newvalues (x).domain, Ada.Strings.Both) = "BOOLEAN" then pl (Trim (Boolean'image (booleanattribute (newvalues (x).all).value), Ada.Strings.Both), False, False); elsif Trim (newvalues (x).domain, Ada.Strings.Both) = "STRING" then pl (Trim (stringattribute (newvalues (x).all).value, Ada.Strings.Both), False, False); elsif Trim (newvalues (x).domain, Ada.Strings.Both) = "INTEGER" then pl (Trim (Integer'image (integerattribute (newvalues (x).all).value), Ada.Strings.Both), False, False); else -- "DATE" pl (Trim (Image (dateattribute (newvalues (x).all).value, ISO_Date), Ada.Strings.Both), False, False); end if; if x < newvalues'length then pl (" ", False, False); end if; end loop; pl (" ", True, False); end loop; end if; pl (outline.all, True, False); pl ("Press Enter >>", False, False); Ada.Text_IO.Get_Immediate (char); end if; sindex := 0; tablename := null; datacols := null; pkcols := null; tupls := null; end parsechosenoption; begin cls; pl ("---------------------------------------------------", True); pl ("Put your table definitions in a file named ", True); pl ("tables.txt and place the file in the same folder as", True); pl ("this program (Parser.exe). Type C to continue or.", True); pl ("~ to quit.", True); pl ("---------------------------------------------------", True); pl (">>", False); Ada.Text_IO.Get (char); line := new String'(Ada.Text_IO.Get_Line); if char = ETX or char = Tilde then raise Ada.IO_Exceptions.End_Error; end if; setinputfile ("tables.txt"); schemas := parsetables; closeinputfile; showoptionsmenu; while line.all /= "~" loop if line.all = "help" or line.all = "HELP" then pl ("---------------------------------------------------", True); pl ("If you want to quit type the tilde '~' character", True); pl ("---------------------------------------------------", True); pl (">>", False); line := new String'(Ada.Text_IO.Get_Line); cls; elsif line.all = "goodbye" or line.all = "GOODBYE" or line.all = "exit" or line.all = "EXIT" or line.all = "quit" or line.all = "QUIT" or line.all = "q" or line.all = "Q" then line := new String'("~"); else ------------------------ -- output results -- ------------------------ getchosenoptiondata; parsechosenoption; showoptionsmenu; end if; end loop; cls; pl ("---------------------------------------------------", True); pl ("Goodbye!", True); pl ("---------------------------------------------------", True); exception when Ada.IO_Exceptions.End_Error => if Ada.Text_IO.Is_Open (input) then Ada.Text_IO.Close (input); end if; cls; pl ("---------------------------------------------------", True); pl ("An error occured while reading data. Possibly a missing", True); pl ("semi-colon or other format character. Or, you pressed ", True); pl ("CTRL + C. Goodbye!", True); pl ("---------------------------------------------------", True); when Ada.Calendar.Time_Error => pl ("A date value was not entered correctly.", True); pl ("Unfortunately this will cause the program to exit.", True); pl ("Your data is safe so long as you don't 'create fresh'.", True); pl ("the table when you start the program again.", True); when Ada.IO_Exceptions.Data_Error => if Ada.Text_IO.Is_Open (input) then Ada.Text_IO.Close (input); end if; when Constraint_Error => Ada.Text_IO.Put_Line ("You entered the data wrong."); end dbprog; with Ada.Text_IO, schema_types, attribute_types; use schema_types, attribute_types; package parser is file : Ada.Text_IO.File_Type; --------------------------- -- Utility Methods -- --------------------------- procedure setinputfile (filename : String); procedure closeinputfile; function parsetables return schema_array_ptr; function parsetable return schema'class; function parseattributes return attribute_array_ptr; function parseattribute return attribute'class; end parser; with Ada.Text_IO, Ada.Directories, Ada.Integer_Text_IO, Ada.Strings.Fixed, Ada.Characters.Latin_1, Ada.IO_Exceptions, schema_types, attribute_types, util; use Ada.Strings.Fixed, Ada.Characters.Latin_1, schema_types, attribute_types, util; package body parser is procedure setinputfile (filename : String) is begin Ada.Text_IO.Open (file, Ada.Text_IO.In_File, filename); end setinputfile; procedure closeinputfile is begin if Ada.Text_IO.Is_Open (file) then Ada.Text_IO.Close (file); end if; end closeinputfile; ----------------------- -- parseTables -- ----------------------- function parsetables return schema_array_ptr is eof : Boolean := False; char : Character; schemas : schema_array_ptr := null; swap : schema_array_ptr := null; schemainfo : schema_ptr := null; i : Integer := 1; begin eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; --at this point we should be ready to read the table name. swap := new schema_array (1 .. max_tables); while not eof loop schemainfo := new schema'class'(parsetable); pl ("Create the table fresh? [y/Y] >>", False, True); Ada.Text_IO.Get (char); swap(i) := new schema(schemainfo.attributes'length); if char = 'y' or char = 'Y' then swap (i) := schemainfo; createtable (swap (i)); else if Ada.Directories.Exists (schemainfo.tablename) then swap (i) := loadtable (schemainfo.tablename); else pl ("No table exists on disc with name = " & schemainfo.tablename, True, True); pl ("You will not be able to query " & schemainfo.tablename, True, True); pl (" ", True, False); end if; end if; i := i + 1; eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); end if; end loop; i := i - 1; if i < 1 then schemas := null; swap := null; else schemas := new schema_array (1 .. i); for x in 1 .. i loop schemas (x) := swap (x); end loop; swap := null; end if; return schemas; end parsetables; ---------------------- -- parseTable -- ---------------------- function parsetable return schema'class is temp : schema_ptr := null; eof : Boolean := False; char : Character; tname : String (1 .. max_tablename_length); attribs : attribute_array_ptr; i : Integer := 1; begin eatWhite (file, eof); --at this point we should be ready to read the table name. --the call to eatwhite might be redundant from the instance that --called 'me' but we want to ensure we are in the right location within --the file. if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; while char /= Space and char /= HT and char /= LF and char /= CR and char /= Left_Parenthesis and not eof loop Ada.Text_IO.Get (file, char); tname (i) := char; i := i + 1; Ada.Text_IO.Look_Ahead (file, char, eof); end loop; for x in i .. max_tablename_length loop tname (x) := ' '; end loop; --We just read the table name. We are expecting an opening '('. --If it's not there then there is a problem with the input file --format. eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); if char = Left_Parenthesis then Ada.Text_IO.Get (file, char); else Ada.Text_IO.Put_Line( " Error in input file format: No attributes found. Must have ()"); end if; else raise Ada.IO_Exceptions.End_Error; end if; attribs := parseattributes; if attribs /= null then temp := new schema (attribs.all'length); temp.attributes := attribs.all; temp.tablename := tname; for x in 1 .. temp.attributes'length loop if temp.attributes (x).all.isprimarykey then temp.primary_key_count := temp.primary_key_count + 1; end if; end loop; else temp := null; end if; --at this point we should have read the ')' for the whole table spec. --if we peek, we should find a ';'. eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); if char = Semicolon then Ada.Text_IO.Get (file, char); else Ada.Text_IO.Put_Line (" Error in input file format: Missing closing ';' on table spec."); temp := null; end if; else Ada.Text_IO.Put_Line (" Error in input file format: Missing closing ')' on table spec."); temp := null; end if; return temp.all; end parsetable; --------------------------- -- parseAttributes -- --------------------------- function parseattributes return attribute_array_ptr is eof : Boolean := False; char : Character; attribs : attribute_array_ptr := null; swap : attribute_array_ptr := null; i : Integer := 1; begin eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; --at this point we should be ready to read the attribute name. if not eof and char /= Right_Parenthesis then Ada.Text_IO.Look_Ahead (file, char, eof); else Ada.Text_IO.Put_Line (" found eof prematurely or ')' is in wrong place."); raise Ada.IO_Exceptions.End_Error; end if; swap := new attribute_array (1 .. max_columns); while char /= Right_Parenthesis and char /= Semicolon and not eof loop swap (i) := new attribute'class'(parseattribute); i := i + 1; eatWhite (file, eof); if not eof and char /= Right_Parenthesis then --we are expecting a ')' or a comma. Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; if char /= Comma and char /= Right_Parenthesis and not eof then Ada.Text_IO.Put_Line (" Error in input file: Missing comma between attributes."); eof := True; swap := null; elsif not eof then --read the comma or the ')' Ada.Text_IO.Get (file, char); end if; eatWhite (file, eof); if eof then Ada.Text_IO.Put_Line ("Missing semi-colon or other format error."); raise Ada.IO_Exceptions.End_Error; end if; end loop; i := i - 1; if i < 1 then swap := null; else attribs := new attribute_array (1 .. i); for x in 1 .. i loop attribs (x) := swap (x); end loop; swap := null; end if; return attribs; end parseattributes; -------------------------- -- parseAttribute -- -------------------------- function parseattribute return attribute'class is temp : attribute_types.attribute_ptr; eof : Boolean := False; char : Character; aname : String (1 .. max_attributename_length); atype : String (1 .. max_typename_length); asize : Integer; isprimarykey : Boolean := False; i : Integer := 1; begin if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; while char /= Space and char /= HT and char /= LF and char /= CR and char /= Left_Parenthesis and char /= Colon and not eof loop Ada.Text_IO.Get (file, char); aname (i) := char; i := i + 1; Ada.Text_IO.Look_Ahead (file, char, eof); end loop; for x in i .. max_attributename_length loop aname (x) := ' '; end loop; --at this point we have the attribute name. Read white space to --a parenthesis or an colon. eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; --the next character should be '(' or ':' if char = Left_Parenthesis then Ada.Text_IO.Get (file, char); eatWhite (file, eof); i := 1; --read "primary" while char /= Space and char /= HT and char /= LF and char /= CR and char /= Right_Parenthesis and not eof loop Ada.Text_IO.Get (file, char); atype (i) := char; i := i + 1; Ada.Text_IO.Look_Ahead (file, char, eof); end loop; for x in i .. max_typename_length loop atype (x) := ' '; end loop; if Trim (atype, Ada.Strings.Both) = "PRIMARY" then isprimarykey := True; end if; eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; i := 1; --read "key" while char /= Space and char /= HT and char /= LF and char /= CR and char /= Right_Parenthesis and not eof loop Ada.Text_IO.Get (file, char); atype (i) := char; i := i + 1; Ada.Text_IO.Look_Ahead (file, char, eof); end loop; for x in i .. max_typename_length loop atype (x) := ' '; end loop; if Trim (atype, Ada.Strings.Both) = "KEY" then isprimarykey := True; else isprimarykey := False; end if; eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; if char = ')' then Ada.Text_IO.Get (file, char); else Ada.Text_IO.Put_Line (" Error in input: Missing ')' after Primary Key designation."); end if; eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; end if; if char = Colon then Ada.Text_IO.Get (file, char); eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; i := 1; --read the type of the attribute into atype variable while char /= Space and char /= HT and char /= LF and char /= CR and char /= Comma and char /= Left_Parenthesis and char /= Right_Parenthesis and char /= Semicolon and not eof loop Ada.Text_IO.Get (file, char); atype (i) := char; i := i + 1; Ada.Text_IO.Look_Ahead (file, char, eof); end loop; for x in i .. max_typename_length loop atype (x) := ' '; end loop; eatWhite (file, eof); --read the left parenthesis if not eof and char = Left_Parenthesis and Trim (atype, Ada.Strings.Both) = "STRING" then Ada.Text_IO.Get (file, char); Ada.Text_IO.Look_Ahead (file, char, eof); elsif not eof and char /= Left_Parenthesis and Trim (atype, Ada.Strings.Both) = "STRING" then Ada.Text_IO.Put_Line (" Incorrect syntax: missing (size) for string."); elsif eof then raise Ada.IO_Exceptions.End_Error; end if; eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; --read the size of the type of the attribute into atype variable while char /= Space and char /= HT and char /= LF and char /= CR and char /= Comma and char /= Right_Parenthesis and char /= Left_Parenthesis and not eof loop Ada.Integer_Text_IO.Get (file, asize, 0); Ada.Text_IO.Look_Ahead (file, char, eof); end loop; --I have to do this temporarily to get this program --to work. ALL strings are the same length. The reason --is because there is no way to know how long the string is --when serializing it in from a file (see loadtable in --schema_types) before we serialize it so that we can --provide a length discriminant to the type defined in --attribute_types. So, we just make them all the same --length. asize := max_stringlength; eatWhite (file, eof); --read the right parenthesis if not eof and char = Right_Parenthesis and Trim (atype, Ada.Strings.Both) = "STRING" then Ada.Text_IO.Get (file, char); Ada.Text_IO.Look_Ahead (file, char, eof); elsif not eof and char /= Right_Parenthesis and Trim (atype, Ada.Strings.Both) = "STRING" then Ada.Text_IO.Put_Line (" Incorrect syntax: missing (size ~)~ for string."); elsif eof then raise Ada.IO_Exceptions.End_Error; end if; eatWhite (file, eof); if Trim (atype, Ada.Strings.Both) = "BOOLEAN" then temp := new booleanattribute; temp.name := aname; temp.domain := atype; if isprimarykey then temp.isprimarykey := True; end if; elsif Trim (atype, Ada.Strings.Both) = "STRING" then temp := new stringattribute; temp.name := aname; temp.domain := atype; if isprimarykey then temp.isprimarykey := True; end if; elsif Trim (atype, Ada.Strings.Both) = "INTEGER" then temp := new integerattribute; temp.name := aname; temp.domain := atype; if isprimarykey then temp.isprimarykey := True; end if; elsif Trim (atype, Ada.Strings.Both) = "DATE" then temp := new dateattribute; temp.name := aname; temp.domain := atype; if isprimarykey then temp.isprimarykey := True; end if; else Ada.Text_IO.Put_Line (" unknown type specified."); end if; --after eating the white space we should be left at the ',' or --the ')'. eatWhite (file, eof); if not eof then Ada.Text_IO.Look_Ahead (file, char, eof); else raise Ada.IO_Exceptions.End_Error; end if; --we leave the comma in the stream so that parseAttributes can --pick it up and loop for the next attribute. We leave the second --')' for parseAttributes to read to know when to exit the loop and --quit parsing attributes. if char /= Comma and char /= Right_Parenthesis then Ada.Text_IO.Put_Line( " Error in input: Missing ')' after Primary Key designation or ',' between attributes.") ; temp := null; end if; else Ada.Text_IO.Put_Line ( " Error in input file: Format not correct, no type specified for attribute " & aname); temp := null; end if; return temp.all; end parseattribute; begin null; end parser; with Ada.Text_IO, Ada.Characters.Latin_1, Ada.Strings.Fixed, Ada.Strings.Maps, Ada.IO_Exceptions; use Ada.Characters.Latin_1; package util is type string_ptr is access all String; type string_array is array (Integer range <>) of string_ptr; type string_array_ptr is access all string_array; max_columns : Integer := 5; max_tables : Integer := 5; max_tablename_length : Integer := 25; max_attributename_length : Integer := 25; max_stringlength : Integer := 255; max_typename_length : Integer := 7; max_filename_length : Integer := 45; max_index_namelength: integer := 50; procedure cls; procedure pl (text : in String; newline : in Boolean; setcolumn : in Boolean := True); function tokenize (text : in String) return string_array_ptr; procedure eatWhite (fin : in out Ada.Text_IO.File_Type; eof : in out Boolean); end util; package body Util is procedure cls is i : Integer := 1; begin while i < 40 loop Ada.Text_IO.New_Line; i := i + 1; end loop; end cls; procedure pl (text : in String; newline : in Boolean; setcolumn : in Boolean := True) is begin if newline then if setcolumn then Ada.Text_IO.Set_Col (15); end if; Ada.Text_IO.Put_Line (text); elsif setcolumn then Ada.Text_IO.Set_Col (15); Ada.Text_IO.Put (text); else Ada.Text_IO.Put (text); end if; end pl; function tokenize (text : in String) return string_array_ptr is temp : string_array_ptr; first : Integer := 1; i : Integer := 1; number_of_commas : Integer := 0; data : string_ptr; data2 : string_ptr; begin data := new String'(text); number_of_commas := Ada.Strings.Fixed.Count (data.all, Ada.Strings.Maps.To_Set (',')); if number_of_commas > max_columns then pl ("Invalid number of columns specified", True); raise Ada.IO_Exceptions.Data_Error; end if; temp := new string_array (1 .. number_of_commas + 1); --first will point to the first comma. first := Ada.Strings.Fixed.Index (data.all, Ada.Strings.Maps.To_Set (','), Ada.Strings.Inside, Ada.Strings.Forward); while i <= number_of_commas and number_of_commas < max_columns loop temp.all (i) := new String'(data.all (1 .. first - 1)); data2 := new String (1 .. data.all'length - first); data2.all := data.all (first + 1 .. data.all'length); data := new String'(data2.all); i := i + 1; first := Ada.Strings.Fixed.Index (data.all, Ada.Strings.Maps.To_Set (','), Ada.Strings.Inside, Ada.Strings.Forward); end loop; temp.all (i) := new String'(data.all); return temp; end tokenize; -------------------- -- eatWhite -- -------------------- procedure eatWhite (fin : in out Ada.Text_IO.File_Type; eof : in out Boolean) is char : Character; begin Ada.Text_IO.Look_Ahead (fin, char, eof); while Ada.Text_IO.End_Of_Line (fin) and not Ada.Text_IO.End_Of_File (fin) loop Ada.Text_IO.Skip_Line (fin); end loop; Ada.Text_IO.Look_Ahead (fin, char, eof); while (char = Space or char = HT or char = LF or char = CR) and not Ada.Text_IO.End_Of_File (fin) loop Ada.Text_IO.Get (fin, char); while Ada.Text_IO.End_Of_Line (fin) and not Ada.Text_IO.End_Of_File (fin) loop Ada.Text_IO.Skip_Line (fin); end loop; Ada.Text_IO.Look_Ahead (fin, char, eof); end loop; end eatWhite; begin null; end Util; with util, Ada.Calendar, attribute_types, Ada.Streams.Stream_IO; use util, attribute_types; package schema_types is --------------------------------- -- Variable Declarations -- --------------------------------- fin : Ada.Streams.Stream_IO.File_Type; fout : Ada.Streams.Stream_IO.File_Type; type schema (number_of_attributes : Integer) is tagged record tablename : String (1 .. max_tablename_length) := (1 .. max_tablename_length => ' '); attributes : attribute_array (1 .. number_of_attributes); byte_start : Integer := 0; byte_end : Integer := 0; primary_key_count : Integer := 0; end record; type schema_ptr is access all schema'class; type schema_array is array (Integer range <>) of schema_ptr; type schema_array_ptr is access all schema_array; type tuple is array (Integer range <>) of attribute_array_ptr; type tuple_ptr is access all tuple; procedure createtable (schemainfo : schema_ptr); function loadtable (sname : String) return schema_ptr; function findrecord (schemainfo : schema; values : attribute_array) return Integer; procedure insertrec (schemainfo : schema; values : attribute_array); procedure deleterec (schemainfo : schema; primary_key_values : attribute_array); procedure updaterec (schemainfo : schema; pkattribs : attribute_array; values : attribute_array); function selectrec (schemainfo : schema) return tuple_ptr; end schema_types; with Ada.Streams.Stream_IO, Ada.Calendar, GNAT.Calendar.Time_IO, Ada.Text_IO, Ada.Strings.Fixed, Ada.Directories, Ada.IO_Exceptions; use Ada.Streams.Stream_IO, Ada.Calendar, GNAT.Calendar.Time_IO, Ada.Strings.Fixed; package body schema_types is procedure createtable (schemainfo : schema_ptr) is fout : File_Type; attribs : attribute_array_ptr; attribs2 : attribute_array_ptr; i : Integer := 1; ii : Integer := 1; temp : access attribute'class; begin if schemainfo = null then return; end if; -- put them in order first for x in 1 .. schemainfo.attributes'length loop for y in x + 1 .. schemainfo.attributes'length loop if schemainfo.attributes (y).name < schemainfo.attributes (x).name then temp := schemainfo.attributes (y); schemainfo.attributes (y) := schemainfo.attributes (x); schemainfo.attributes (x).all := temp.all; end if; end loop; end loop; attribs := new attribute_array (1 .. schemainfo.attributes'length); attribs2 := new attribute_array (1 .. schemainfo.attributes'length); for x in 1 .. schemainfo.attributes'length loop if schemainfo.attributes (x).isprimarykey then attribs (i) := schemainfo.attributes (x); i := i + 1; else attribs2 (ii) := schemainfo.attributes (x); ii := ii + 1; end if; end loop; i := i - 1; ii := ii - 1; -- the primary_key attributes first for x in 1 .. i loop schemainfo.attributes (x) := attribs (x); end loop; -- non-primary key attributes next for x in 1 .. ii loop schemainfo.attributes (x + i) := attribs2 (x); end loop; Create (fout, Out_File, Trim (schemainfo.all.tablename, Ada.Strings.Both)); --We are writing the number of attributes so that when we load --the table we can determine the number of attributes to put --into the new, loading schema. Integer'write (Stream (fout), schemainfo.all.attributes'length); schemainfo.all.byte_start := Integer'val (Index (fout)); --we output it once so that we can capture the file position for byte_end schema'output (Stream (fout), schemainfo.all); --fill in byte_end schemainfo.all.byte_end := Integer'val (Index (fout)); close(fout); Open (fout, Out_File, Trim (schemainfo.all.tablename, Ada.Strings.Both)); Integer'write (Stream (fout), schemainfo.all.attributes'length); --now we have byte_start and byte_end schema'output (Stream (fout), schemainfo.all); for x in 1 .. schemainfo.all.attributes'length loop to_disc(fout, schemainfo.all.attributes(x).all); end loop; Close (fout); end createtable; function loadtable (sname : String) return schema_ptr is schemainfo : schema_ptr; fin : File_Type; length : Integer; position : integer; begin Open (fin, In_File, Trim (sname, Ada.Strings.Both)); Integer'read (Stream (fin), length); schemainfo := new schema (length); schemainfo.all := schema'class'input (Stream (fin)); --mark where we are at in the file to start reading attributes. position := Integer'val (Index (fin)); for x in 1 .. schemainfo.attributes'length loop ----------------------------------------------------- -- Old code I plan on removing ----------------------------------------------------- -- schemainfo.all.attributes (x).all.byte_start := position; -- -- if Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then -- schemainfo.all.attributes (x) := new booleanattribute; -- schemainfo.all.attributes (x).all := -- booleanattribute'input (Stream (fin)); -- elsif Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "STRING" then -- schemainfo.all.attributes (x) := new stringattribute; -- schemainfo.all.attributes (x).all := -- stringattribute'input (Stream (fin)); -- elsif Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "INTEGER" then -- schemainfo.all.attributes (x) := new integerattribute; -- schemainfo.all.attributes (x).all := -- integerattribute'input (Stream (fin)); -- else -- "DATE" -- schemainfo.all.attributes (x) := new dateattribute; -- schemainfo.all.attributes (x).all := -- dateattribute'input (Stream (fin)); -- end if; -- position := Integer'val (Index (fin)); -- schemainfo.all.attributes (x).all.byte_end := position; -- End old code ------------------------------------------------------ ----------------------------------------------------------- -- The code I want to use for dispatching ----------------------------------------------------------- -- schemainfo.all.attributes (x) := new attribute'class'(from_disc(fin, schemainfo.all.attributes (x).all)); ----------------------------------------------------------- ------------------------------------------------------------ -- Debug code below -- ------------------------------------------------------------ -- For some reason some of the attributes on schemainfo come through -- as "unknown" after the schemainfo was filled in from 'input(stream). -- It doesn't appear to me that createtable procedure in this package -- writes the schema object incorrectly so I don't understand why -- the attributes of the schemainfo object we retrieve with 'input are -- "unknown". Well, the domain member of the attribute is not one of -- BOOLEAN, STRING, INTEGER or DATE; that's why it prints it but why -- isn't the domain member one of those values? if Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "BOOLEAN" then ada.text_io.put_line(schemainfo.all.attributes (x).name); ada.text_io.put_line(schemainfo.all.attributes (x).domain); elsif Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "STRING" then ada.text_io.put_line(schemainfo.all.attributes (x).name); ada.text_io.put_line(schemainfo.all.attributes (x).domain); elsif Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "INTEGER" then ada.text_io.put_line(schemainfo.all.attributes (x).name); ada.text_io.put_line(schemainfo.all.attributes (x).domain); elsif Trim (schemainfo.all.attributes (x).domain, Ada.Strings.Both) = "DATE" then ada.text_io.put_line(schemainfo.all.attributes (x).name); ada.text_io.put_line(schemainfo.all.attributes (x).domain); else ada.text_io.put_line("unknown"); end if; end loop; -- End Debug Code --------------------------------------------------------------- Close (fin); return schemainfo; exception when Ada.IO_Exceptions.Status_Error => Ada.Text_IO.Put_Line ("Status error in loadtable"); return null; end loadtable; --------------------- -- INSERT RECORD -- --------------------- procedure insertrec (schemainfo : schema; values : attribute_array) is location : Integer := -1; char : Character; begin location := findrecord (schemainfo, values); --if the record isn't in there it is -1 if location = -1 then Open (fout, Append_File, Trim (schemainfo.tablename, Ada.Strings.Both)); for x in 1 .. schemainfo.attributes'length loop to_disc(fout, values (x).all); end loop; Close (fout); else pl ("Record already exists with that key", True, True); pl ("Press Enter to continue...", True, True); Ada.Text_IO.Get_Immediate (char); end if; end insertrec; --------------------- -- SELECT RECORD -- --------------------- function selectrec (schemainfo : schema) return tuple_ptr is temp : attribute_array_ptr; recs : tuple_ptr; recs2 : tuple_ptr; i : Integer := 1; begin Open (fin, In_File, Trim (schemainfo.tablename, Ada.Strings.Both)); Set_Index (fin, Ada.Streams.Stream_IO.Count'val (schemainfo.attributes (schemainfo.attributes'length).all.byte_end)); temp := new attribute_array (1 .. schemainfo.attributes'length); if End_Of_File (fin) then Close (fin); return null; end if; recs := new tuple (1 .. 1); while not End_Of_File (fin) loop for x in 1 .. temp.all'length loop temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes (x).all)); end loop; if i < 2 then recs (recs'last) := temp; else recs2 := new tuple (1 .. recs'length); for z in 1 .. recs'length loop recs2 (z) := recs (z); end loop; recs := new tuple (1 .. i); for z in 1 .. recs2'length loop recs (z) := recs2 (z); end loop; recs (recs'last) := temp; end if; temp := new attribute_array (1 .. schemainfo.attributes'length); i := i + 1; end loop; Close (fin); return recs; end selectrec; ------------------- -- FIND RECORD -- ------------------- function findrecord (schemainfo : schema; values : attribute_array) return Integer is temp : attribute_array_ptr; location : Ada.Streams.Stream_IO.Count; found : Integer := 0; done : Boolean := False; comparrisons : Integer := 0; begin Open (fin, In_File, Trim (schemainfo.tablename, Ada.Strings.Both)); Set_Index (fin, Ada.Streams.Stream_IO.Count'val (schemainfo.attributes (schemainfo.attributes'length).all.byte_end)); temp := new attribute_array (1 .. schemainfo.attributes'length); while not End_Of_File (fin) and then not done loop --mark our current location in the file. location := Index (fin); --read the whole line from the file, for x in 1 .. schemainfo.attributes'length loop temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes(x).all)); end loop; --then compare them. comparrisons := 0; found := 0; for x in 1 .. values'length loop if schemainfo.attributes (x).isprimarykey then comparrisons := comparrisons + 1; if Trim (values (x).domain, Ada.Strings.Both) = "BOOLEAN" then if booleanattribute (temp (x).all).value = booleanattribute (values (x).all).value then found := found + 1; end if; -- ada.text_io.put_line(boolean'image(booleanattribute(temp(x).all).value --)); elsif Trim (values (x).domain, Ada.Strings.Both) = "STRING" then if stringattribute (temp (x).all).value = stringattribute (values (x).all).value then found := found + 1; end if; -- ada.text_io.put_line(stringattribute(temp(x).all).value); elsif Trim (values (x).domain, Ada.Strings.Both) = "INTEGER" then if integerattribute (temp (x).all).value = integerattribute (values (x).all).value then found := found + 1; end if; -- ada.text_io.put_line(integer'image(integerattribute(temp(x).all).value --)); else -- "DATE" if dateattribute (temp (x).all).value = dateattribute (values (x).all).value then found := found + 1; end if; -- ada.text_io.put_line(image(dateattribute(temp(x).all).value, --iso_date)); end if; end if; end loop; if found = comparrisons and then comparrisons > 0 then done := True; end if; if End_Of_File (fin) then done := True; end if; end loop; Close (fin); if found < comparrisons then return -1; elsif found = 0 and then comparrisons = 0 then return -1; else return Integer'val (location); end if; end findrecord; --------------------- -- DELETE RECORD -- --------------------- procedure deleterec (schemainfo : schema; primary_key_values : attribute_array) is location : Integer; original_byte_end : Integer := schemainfo.attributes (schemainfo.attributes'last).byte_end; temp : attribute_array_ptr; char : Character; begin location := findrecord (schemainfo, primary_key_values); --If findrecord seeks past the schema info header in the file and ends --on the end of file it will return -1. Therefore, no records to delete --in the file. if location = -1 then pl ("No records to delete with that key", True, True); pl ("Press Enter to continue...", True, True); Ada.Text_IO.Get_Immediate (char); return; end if; Create (fout, Out_File, "swapfile"); Open (fin, In_File, Trim (schemainfo.tablename, Ada.Strings.Both)); --output the schema header information to the file Integer'write (Stream (fout), schemainfo.attributes'length); --I took these out so that we could create a function for --updating records that returns an rrn. functions do not --allow out mode parameters and deleterec had an out mode --parameter because of this next line. --schemainfo.byte_start := Integer'val (Index (fout)); schema'output (Stream (fout), schemainfo); --I took these out so that we could create a function for --updating records that returns an rrn. functions do not --allow out mode parameters and deleterec had an out mode --parameter because of this next line. --schemainfo.byte_end := Integer'val (Index (fout)); for x in 1 .. schemainfo.attributes'length loop to_disc(fout, schemainfo.attributes(x).all); end loop; --set the index on the input file so we skip the header on input file. Set_Index (fin, Ada.Streams.Stream_IO.Count'val (original_byte_end)); temp := new attribute_array (1 .. schemainfo.attributes'length); --Read records from one file and insert them into the other file until --we get to the location of the record we want to delete. while Index (fin) < Ada.Streams.Stream_IO.Count'val (location) loop for x in 1 .. temp.all'length loop temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes(x).all)); to_disc(fin, temp(x).all); end loop; end loop; --do a blank read to move past the line to delete for x in 1 .. schemainfo.attributes'length loop temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes(x).all)); end loop; --output the rest of the records. while not End_Of_File (fin) loop for x in 1 .. temp.all'length loop temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes(x).all)); to_disc(fout, temp(x).all); end loop; end loop; Close (fin); Close (fout); Ada.Directories.Delete_File (Trim (schemainfo.tablename, Ada.Strings.Both)); Ada.Directories.Rename ("swapfile", Trim (schemainfo.tablename, Ada.Strings.Both)); location := findrecord (schemainfo, primary_key_values); if location >= 1 then deleterec (schemainfo, primary_key_values); end if; end deleterec; --------------------- -- UPDATE RECORD -- --------------------- procedure updaterec (schemainfo : schema; pkattribs : attribute_array; values : attribute_array) is position : Integer := 0; char : Character; begin position := findrecord (schemainfo, pkattribs); --if the record doesn't exist then insert it if position < 1 then pl ("That record doesn't exist in the database.", True, True); pl ("Insert it instead (menu item 1).", True, True); pl ("Press Enter to continue...", True, True); Ada.Text_IO.Get_Immediate (char); elsif position >= 1 then deleterec (schemainfo, pkattribs); insertrec (schemainfo, values); end if; end updaterec; begin null; end schema_types; with util, Ada.Calendar, ada.streams.stream_io; use util, Ada.Calendar, ada.streams.stream_io; package attribute_types is ----------------------------------- -- Forwarding Declarations -- ----------------------------------- type attribute is abstract tagged; type booleanattribute is tagged; type integerattribute is tagged; type stringattribute is tagged; type dateattribute is tagged; -------------------------------------- -- Attribute Type Declarations -- -------------------------------------- type attribute is abstract tagged record name : String (1 .. max_attributename_length) := (1 .. max_attributename_length => ' '); domain : String (1 .. max_typename_length) := (1 .. max_typename_length => ' '); isprimarykey : Boolean := False; byte_start : Integer := 0; byte_end : Integer := 0; end record; -------------------------------------- -- Basic Pointer Declarations -- -------------------------------------- type attribute_ptr is access attribute'class; type attribute_array is array (Integer range <>) of access attribute'class; type attribute_array_ptr is access all attribute_array; procedure to_disc (fout: file_type; item: in out attribute) is abstract; function from_disc(fout: file_type; item: attribute) return attribute'class is abstract; ----------------------------------- -- Extended Attribute Types -- ----------------------------------- type booleanattribute is new attribute with record value : Boolean := False; end record; type booleanattribute_ptr is access all booleanattribute'class; procedure to_disc (fout: file_type; item: in out booleanattribute); function from_disc(fin: file_type; item: booleanattribute) return attribute'class; type integerattribute is new attribute with record value : Integer := 0; end record; type integerattribute_ptr is access all integerattribute'class; procedure to_disc (fout: file_type; item: in out integerattribute); function from_disc(fin: file_type; item: integerattribute) return attribute'class; type stringattribute is new attribute with record value : String (1 .. max_stringlength) := (1 .. max_stringlength => ' '); end record; type stringattribute_ptr is access all stringattribute'class; procedure to_disc (fout: file_type; item: in out stringattribute); function from_disc(fin: file_type; item: stringattribute) return attribute'class; type dateattribute is new attribute with record year : Year_Number := 1901; month : Month_Number := 1; day : Day_Number := 1; value : Time := Time_Of (1901, 1, 1); end record; type dateattribute_ptr is access all dateattribute'class; procedure to_disc (fout: file_type; item: in out dateattribute); function from_disc(fin: file_type; item: dateattribute) return attribute'class; end attribute_types; with ada.text_io, util, ada.calendar; use util, ada.calendar; package body attribute_types is procedure to_disc (fout: file_type; item: in out booleanattribute) is begin item.byte_start := Integer'val (Index (fout)); item.byte_end := Integer'val (Index (fout)) + (booleanattribute'size / 8) - 7; booleanattribute'class'output(Stream(fout), item); end to_disc; function from_disc(fin: file_type; item: booleanattribute) return attribute'class is temp : access attribute'class; begin temp := new booleanattribute; temp.all := booleanattribute'class'input (Stream (fin)); return temp.all; end from_disc; procedure to_disc (fout: file_type; item: in out integerattribute) is begin item.byte_start := Integer'val (Index (fout)); item.byte_end := Integer'val (Index (fout)) + (integerattribute'size / 8) - 7; integerattribute'class'output(Stream(fout), item); end to_disc; function from_disc(fin: file_type; item: integerattribute) return attribute'class is temp : access attribute'class; begin temp := new integerattribute; temp.all := integerattribute'class'input (Stream (fin)); return temp.all; end from_disc; procedure to_disc (fout: file_type; item: in out stringattribute) is begin item.byte_start := Integer'val (Index (fout)); item.byte_end := Integer'val (Index (fout)) + (stringattribute'size / 8) - 7; stringattribute'class'output(Stream(fout), item); end to_disc; function from_disc(fin: file_type; item: stringattribute) return attribute'class is temp: access attribute'class; begin temp := new stringattribute; temp.all := stringattribute'class'input (Stream (fin)); return temp.all; end from_disc; procedure to_disc (fout: file_type; item: in out dateattribute) is begin item.byte_start := Integer'val (Index (fout)); item.byte_end := Integer'val (Index (fout)) + (dateattribute'size / 8) - 11; dateattribute'class'output(Stream(fout), item); end to_disc; function from_disc(fin: file_type; item: dateattribute) return attribute'class is temp: access attribute'class; begin temp := new dateattribute; temp.all := dateattribute'class'input (Stream (fin)); return temp.all; end from_disc; begin null; end attribute_types; with Ada.Streams.Stream_IO, util, attribute_types,Ada.Calendar; use util, attribute_types,Ada.Calendar; package index_types is --------------------------------- -- Variable Declarations -- --------------------------------- fin : Ada.Streams.Stream_IO.File_Type; fout : Ada.Streams.Stream_IO.File_Type; -------------------------------------------------------- -- THIS FILE IS NOT COMPLETE NOR USED YET!!! -- IT IS INCLUDED BECAUSE IT IS WITH'D -------------------------------------------------------- --an index is a file --it contains the primary key value and file position for the primary key for a primary index --the spec sounds like only one attribute will make up a primary key. --for a secondary index it contains an attribute and a position. --The spec says only one attribute. --primary indexes are named after the table it belongs to _PIDX --secondary indexes are named after the table it belongs to like _SIDX --each schema object has a list of index names for a table --initially the list of index names is empty --the user adds an index to the table and then the index name goes into the list of indexes on --the schema --the schema information will have to be re-written to the table file when an index is added. --This is the same for the secondary indexes --if a tuple that an index is based on is inserted, deleted or updated then the index must be --loaded and re-created. ----on updates we only have to change the index if the index value is being changed. --The attributes store the name of an index on itself. When we load the schema --we go through each attribute and determine if it is indexed then load that --index if it is. This gives us the "type" on the index value, elleviates the --need to maintain a list of index names in the schema object, ----what do we load an index into? --There are two types of indexes: primary and secondary --** note ** the primary index is just like the secondary; it only has one entry per item --because there is only --one item allowed per entry due to the fact that primary keys are unique. --The differences in indexes are: ----if we remove a value from a secondary we must match the rrn to remove the correct --item; with a primary key there is only one to remove. ----when finding a record, with a primary index when we find the value we don't ----have to search a bunch of records for the exact tuple match. With secondary ----, because there are multiple values that are the same with different rrn's ----we have to search each rrn and compare values to match the tuple. --we don't sort as we read the table, we read the table and then sort the index file. type index is abstract tagged record filename : String (1 .. max_index_namelength); rrn : Ada.Streams.Stream_IO.Count := 0; end record; type index_ptr is access all index; type index_array is array (Integer range <>) of index_ptr; type booleanindex is tagged record key : boolean; end record; type integerindex is tagged record key : integer; end record; type stringindex is tagged record key : string(1..max_stringlength); end record; type dateindex is tagged record key : time; end record; end index_types; ************************* * Contents of the table.txt file * This file is used by the main procedure dbprog. * It must be labeled tables.txt and placed in the * same directory as the executable dbprog.exe ************************* T3( ID(PRIMARY KEY):INTEGER ); T2( DATA(PRIMARY KEY):STRING(15) ); T4( II(PRIMARY KEY):DATE ); T1( mine(PRIMARY KEY):BOOLEAN ); *************************