Description
Adablog uses an MVC style model of programming similar for Ruby on Rails.
It demonstrates how flexible Gnoga can be and that it is just as capable in the area of web sites, as web apps or application GUIs.
An effort was made to also make more use of attaching to the DOM of existing pages and avoiding app data types.
This applications uses SQLite.
Source code
adablog.ads
with Gnoga.Server.Database.SQLite;
package AdaBlog is
use Gnoga;
use all type Gnoga.String;
Connection : Gnoga.Server.Database.Connection_Access := Gnoga.Server.Database.SQLite.Connect ("adablog.db");
end AdaBlog;adablog-controller.ads
with Gnoga.Gui.Window;
with Gnoga.Application.Multi_Connect;
package AdaBlog.Controller is
procedure Index
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Connection : access Gnoga.Application.Multi_Connect.Connection_Holder_Type);
procedure New_Entry
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Connection : access Gnoga.Application.Multi_Connect.Connection_Holder_Type);
procedure Log_Out
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Connection : access Gnoga.Application.Multi_Connect.Connection_Holder_Type);
end AdaBlog.Controller;adablog-controller.adb
with Ada.Calendar;
with Gnoga.Types;
with Gnoga.Gui.Base;
with Gnoga.Gui.Element;
with Gnoga.Gui.Element.Common;
with Gnoga.Gui.Element.Form;
with AdaBlog.View;
with AdaBlog.Model;
package body AdaBlog.Controller is
procedure On_Create_User (Object : in out Gnoga.Gui.Base.Base_Type'Class);
-- The create user button was clicked
procedure On_User_Login (Object : in out Gnoga.Gui.Base.Base_Type'Class);
-- User clicked the submit button for his user name and password
procedure On_Submit_Entry (Object : in out Gnoga.Gui.Base.Base_Type'Class);
-- User clicked the submit button to an a blog entry.
procedure On_Create_User (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
Main_Window : aliased Gui.Window.Window_Type;
Message_Area : Gui.Element.Common.DIV_Type;
User_Login : Gui.Element.Common.Button_Type;
username : Gui.Element.Form.Text_Type;
password : Gui.Element.Form.Text_Type;
pass2 : Gui.Element.Form.Text_Type;
verify : Gui.Element.Common.DIV_Type;
User : AdaBlog.Model.Users.Active_Record;
begin
Main_Window.Attach (Object.Connection_ID);
Message_Area.Attach_Using_Parent (Main_Window, "message");
User_Login.Attach_Using_Parent (Main_Window, "login-button");
User_Login.Disabled;
username.Attach_Using_Parent (Main_Window, "username");
password.Attach_Using_Parent (Main_Window, "pass");
pass2.Attach_Using_Parent (Main_Window, "pass2");
verify.Attach_Using_Parent (Main_Window, "verify-pass");
verify.Display ("inline");
if Gnoga.String'(password.Value) /= Gnoga.String'(pass2.Value) or pass2.Value = "" then
Message_Area.Text ("Please verify password.");
return;
end if;
if username.Value = "" then
Message_Area.Text ("Username is required.");
return;
end if;
User.Find_Where ("username='" & username.Value & "'");
if User.Value ("id") /= "" then
Message_Area.Text ("Username is already taken.");
return;
end if;
User.Value ("username", Value => username.Value);
User.Value ("pass", Value => password.Value);
User.Value ("last_session", Value => Main_Window.Gnoga_Session_ID);
User.Save;
Main_Window.Location.URL ("/");
end On_Create_User;
procedure On_User_Login (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
Main_Window : aliased Gui.Window.Window_Type;
Message_Area : Gui.Element.Common.DIV_Type;
username : Gui.Element.Form.Text_Type;
password : Gui.Element.Form.Text_Type;
User : AdaBlog.Model.Users.Active_Record;
begin
Main_Window.Attach (Object.Connection_ID);
Message_Area.Attach_Using_Parent (Main_Window, "message");
username.Attach_Using_Parent (Main_Window, "username");
password.Attach_Using_Parent (Main_Window, "pass");
User.Find_Where
(Where => "username ='" & username.Value & "'" & " AND " & "pass ='" & password.Value & "'",
Create_New => False);
User.Value ("last_session", Value => Main_Window.Gnoga_Session_ID);
User.Save;
Main_Window.Location.URL ("/");
exception
when others =>
Message_Area.Text ("Invalid Login");
end On_User_Login;
procedure On_Submit_Entry (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
User : AdaBlog.Model.Users.Active_Record;
Entries : AdaBlog.Model.Blog_Entries.Active_Record;
Main_Window : aliased Gui.Window.Window_Type;
Text : Gnoga.Gui.Element.Form.Text_Area_Type;
begin
Main_Window.Attach (Object.Connection_ID);
Text.Attach_Using_Parent (Main_Window, "entry_text");
User.Find_Where ("last_session ='" & Main_Window.Gnoga_Session_ID & "'");
Entries.Value ("user_id", Value => User.Value ("id"));
Entries.Value ("entry_date", Date_Value => Ada.Calendar.Clock);
Entries.Value ("entry_text", Value => Text.Value);
Entries.Save;
Main_Window.Location.URL ("/");
end On_Submit_Entry;
procedure Index
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Connection : access Gnoga.Application.Multi_Connect.Connection_Holder_Type)
is
Content_Area : Gui.Element.Common.DIV_Type;
Left_Area : Gui.Element.Common.DIV_Type;
User_Login : Gui.Element.Common.Button_Type;
Create_User : Gui.Element.Common.Button_Type;
User : AdaBlog.Model.Users.Active_Record;
procedure Display_Row (Row : Gnoga.Types.Data_Map_Type);
procedure Display_Row (Row : Gnoga.Types.Data_Map_Type) is
begin
AdaBlog.View.Display_Blog_Entry (Content_Area, Row);
end Display_Row;
begin
User.Find_Where ("last_session ='" & Main_Window.Gnoga_Session_ID & "'");
Main_Window.Disable_Auto_Set_View;
Content_Area.Create (Parent => Main_Window, ID => "main-body");
AdaBlog.Connection.Iterate
(SQL =>
"select username, entry_date, entry_text " & "from users, blog_entries " &
"where users.id=blog_entries.user_id",
Process => Display_Row'Unrestricted_Access);
View.User_Panel (Main_Window => Main_Window, Panel => Left_Area, User_Record => User.Values);
View.Template (Main_Window => Main_Window, Content => Content_Area, Left_Panel => Left_Area);
User_Login.Attach_Using_Parent (Main_Window, "login-button");
User_Login.On_Click_Handler (On_User_Login'Access);
Create_User.Attach_Using_Parent (Main_Window, "create-button");
Create_User.On_Click_Handler (On_Create_User'Access);
Connection.Hold;
end Index;
procedure New_Entry
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Connection : access Gnoga.Application.Multi_Connect.Connection_Holder_Type)
is
User : AdaBlog.Model.Users.Active_Record;
Content_Area : Gui.Element.Common.DIV_Type;
Left_Area : Gui.Element.Common.DIV_Type;
Submit : Gui.Element.Common.Button_Type;
begin
User.Find_Where ("last_session ='" & Main_Window.Gnoga_Session_ID & "'");
if User.Value ("id") = "" then
Main_Window.Location.URL ("/");
return;
end if;
Main_Window.Disable_Auto_Set_View;
View.New_Entry_Form (Main_Window => Main_Window, Content => Content_Area);
View.User_Panel (Main_Window => Main_Window, Panel => Left_Area, User_Record => User.Values);
View.Template (Main_Window => Main_Window, Content => Content_Area, Left_Panel => Left_Area);
Submit.Attach_Using_Parent (Main_Window, "submit_entry");
Submit.On_Click_Handler (On_Submit_Entry'Access);
Connection.Hold;
end New_Entry;
procedure Log_Out
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Connection : access Gnoga.Application.Multi_Connect.Connection_Holder_Type)
is
pragma Unreferenced (Connection);
User : AdaBlog.Model.Users.Active_Record;
begin
User.Find_Where ("last_session ='" & Main_Window.Gnoga_Session_ID & "'");
if User.Value ("id") /= "" then
User.Value ("last_session", "");
User.Save;
end if;
Main_Window.Location.URL ("/");
end Log_Out;
begin
Application.Multi_Connect.On_Connect_Handler (Controller.Index'Unrestricted_Access, "default");
Application.Multi_Connect.On_Connect_Handler (Controller.Index'Unrestricted_Access, "main");
Application.Multi_Connect.On_Connect_Handler (New_Entry'Unrestricted_Access, "new_entry");
Application.Multi_Connect.On_Connect_Handler (Log_Out'Unrestricted_Access, "logout");
end AdaBlog.Controller;adablog-view.ads
with Gnoga.Types;
with Gnoga.Gui.Window;
with Gnoga.Gui.Element.Common;
package AdaBlog.View is
procedure Display_Blog_Entry
(Parent : in out Gnoga.Gui.Element.Common.DIV_Type'Class;
Data : in Gnoga.Types.Data_Map_Type);
-- Adds blog entries to content
procedure New_Entry_Form
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Content : in out Gnoga.Gui.Element.Common.DIV_Type'Class);
-- Creates new entry form for content
procedure User_Panel
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Panel : in out Gnoga.Gui.Element.Common.DIV_Type'Class;
User_Record : in Gnoga.Types.Data_Map_Type);
-- Setup Panel with User_Record information or Login if User_Record empty
procedure Template
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Content : in out Gnoga.Gui.Element.Common.DIV_Type'Class;
Left_Panel : in out Gnoga.Gui.Element.Common.DIV_Type'Class);
-- Content will be placed in to Content area of Template
end AdaBlog.View;adablog-view.adb
package body AdaBlog.View is
procedure Display_Blog_Entry
(Parent : in out Gnoga.Gui.Element.Common.DIV_Type'Class;
Data : in Gnoga.Types.Data_Map_Type)
is
Entry_Div : Gnoga.Gui.Element.Common.DIV_Type;
begin
Entry_Div.Create
(Parent,
"<div class='blog_entry'>" & "<div class='blog_user'>" & Data.Element ("username") & "</div>" &
"<div class='blog_date'> said on " & Data.Element ("entry_date") & ":</div><br />" &
"<div class='blog_text'>" & Data.Element ("entry_text") & "</div></div>");
end Display_Blog_Entry;
procedure New_Entry_Form
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Content : in out Gnoga.Gui.Element.Common.DIV_Type'Class)
is
begin
Content.Create
(Parent => Main_Window,
Content =>
"<div><form>" & "Blog Entry: <br />" & "<textarea cols=60 rows=10 id='entry_text' " &
"name='entry_text' autofocus></textarea>" & "<input type='button' id='submit_entry' " &
"value='Submit'></form></div>",
ID => "main-body");
end New_Entry_Form;
procedure User_Panel
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Panel : in out Gnoga.Gui.Element.Common.DIV_Type'Class;
User_Record : in Gnoga.Types.Data_Map_Type)
is
begin
if not User_Record.Contains ("username") then
Panel.Create
(Parent => Main_Window,
Content =>
"<form>" & "Username: <input type=text name='username' " & "id='username' size='20' autofocus><br />" &
"Password : <input type=password name='pass' " & "id='pass' size='20'><br />" &
"<div id='verify-pass' style='display:none'> " & "Verify Password : <input type=password name='pass2' " &
"id='pass2' size='20'><br /></div>" & "<input id='login-button' type='button'" & " value='Submit'> " &
"<input id='create-button' type='button'" & " value='Create'> <br/>" & "</form>",
ID => "left-panel");
else
Panel.Create
(Parent => Main_Window,
Content =>
" Username: <b>" & User_Record.Element ("username") & "</b><br /><br />" & "<a href='/new_entry'>" &
"Add Entry</a><br /><br />" & "<a href='/logout'>Logout</a ><br/>",
ID => "left-panel");
end if;
end User_Panel;
procedure Template
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Content : in out Gnoga.Gui.Element.Common.DIV_Type'Class;
Left_Panel : in out Gnoga.Gui.Element.Common.DIV_Type'Class)
is
Title_Div : Gnoga.Gui.Element.Common.DIV_Type;
Message_Area : Gnoga.Gui.Element.Common.DIV_Type;
begin
Main_Window.Document.Load_CSS ("/css/adablog.css");
Main_Window.Disable_Auto_Set_View;
Title_Div.Create (Parent => Main_Window, Content => "AdaBlog", ID => "title");
Title_Div.Place_Inside_Top_Of (Main_Window.Document.Body_Element.all);
Left_Panel.Place_After (Title_Div);
Content.Place_After (Left_Panel);
Message_Area.Create (Main_Window, ID => "message");
Message_Area.Place_Inside_Top_Of (Content);
end Template;
end AdaBlog.View;adablog-migrations.adb
with Gnoga.Server.Migration;
procedure AdaBlog.Migrations (M : in out Gnoga.Server.Migration.Migration_Collection) is
begin
-- Add migrations here
M.Add_Migration_Up
("CREATE TABLE `users`" & " (" & AdaBlog.Connection.ID_Field_String & "," & " username VARCHAR(80)," &
" pass VARCHAR(80)," & " last_session VARCHAR(80))");
M.Add_Migration_Down ("DROP TABLE `users`");
M.Add_Migration_Up
("CREATE TABLE `blog_entries`" & " (" & AdaBlog.Connection.ID_Field_String & "," & " user_id INTEGER," &
" entry_date DATE," & " entry_text TEXT)");
M.Add_Migration_Down ("DROP TABLE `blog_entries`");
end AdaBlog.Migrations;adablog-model.ads
with Gnoga.Server.Model.Table;
package AdaBlog.Model is
package Users is new Gnoga.Server.Model.Table ("users", Connection);
package Blog_Entries is new Gnoga.Server.Model.Table ("blog_entries", Connection);
end AdaBlog.Model;adablog-main.adb
with GNAT.OS_Lib;
with Gnoga.Application.Multi_Connect;
with Gnoga.Server.Migration;
with AdaBlog.Migrations;
with AdaBlog.Controller;
procedure AdaBlog.Main is
pragma Linker_Options ("-lsqlite3");
begin
if Gnoga.Server.Migration.Migrations_Handled_Command_Line (Connection, Migrations'Unrestricted_Access) then
GNAT.OS_Lib.OS_Exit (0);
end if;
Application.Title ("AdaBlog - Gnoga Demo");
Application.HTML_On_Close ("<b>Connection to Application has been terminated</b>");
Application.Multi_Connect.Initialize (Boot => "debug.html");
Application.Multi_Connect.Message_Loop;
exception
when E : others =>
Log (E);
end AdaBlog.Main;
Project file
with "settings.gpr";
with "gnoga.gpr";
project AdaBlog is
for Object_Dir use Settings.Obj_Dir;
for Exec_Dir use Settings.Exe_Dir;
for Main use ("adablog-main.adb");
for Create_Missing_Dirs use Settings'Create_Missing_Dirs;
package Builder is
for Executable ("adablog-main.adb") use "adablog";
end Builder;
package Compiler is
for Default_Switches ("Ada") use Settings.Compiler'Default_Switches ("Ada") & "-gnatyN";
end Compiler;
package Binder renames Settings.Binder;
package Linker renames Settings.Linker;
package Pretty_Printer renames Settings.Pretty_Printer;
end AdaBlog;