mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
278 lines
7.3 KiB
ObjectPascal
278 lines
7.3 KiB
ObjectPascal
// ***************************************************************************
|
|
//
|
|
// Delphi MVC Framework
|
|
//
|
|
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
|
|
//
|
|
// https://github.com/danieleteti/delphimvcframework
|
|
//
|
|
//
|
|
// ***************************************************************************
|
|
//
|
|
// Sempare Template Engine
|
|
//
|
|
// Copyright (c) 2019-2023 Conrad Vermeulen and Sempare Limited
|
|
//
|
|
// https://github.com/sempare/sempare-delphi-template-engine
|
|
//
|
|
// NOTE: The Sempare Template Engine is available under GPL or commercial license.
|
|
//
|
|
// Free as in speech, NOT Free as in beer.
|
|
//
|
|
// ***************************************************************************
|
|
//
|
|
// This example is licensed under the Apache License.
|
|
//
|
|
// Licensed under the Apache License, Version 2.0 (the "License");
|
|
// you may not use this file except in compliance with the License.
|
|
// You may obtain a copy of the License at
|
|
//
|
|
// http://www.apache.org/licenses/LICENSE-2.0
|
|
//
|
|
// Unless required by applicable law or agreed to in writing, software
|
|
// distributed under the License is distributed on an "AS IS" BASIS,
|
|
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
// See the License for the specific language governing permissions and
|
|
// limitations under the License.
|
|
//
|
|
// ***************************************************************************
|
|
unit WebSiteControllerU;
|
|
|
|
interface
|
|
|
|
uses
|
|
MVCFramework, System.Diagnostics, JsonDataObjects, MVCFramework.Commons, DAL,
|
|
System.Generics.Collections;
|
|
|
|
type
|
|
|
|
[MVCPath('/')]
|
|
TWebSiteController = class(TMVCController)
|
|
protected
|
|
procedure OnBeforeAction(Context: TWebContext; const AActionNAme: string; var Handled: Boolean); override;
|
|
procedure GeneratePeopleListAsCSV;
|
|
public
|
|
[MVCPath('/people')]
|
|
[MVCHTTPMethods([httpGET])]
|
|
[MVCProduces(TMVCMediaType.TEXT_HTML)]
|
|
procedure PeopleList;
|
|
|
|
[MVCPath('/people')]
|
|
[MVCHTTPMethods([httpGET])]
|
|
[MVCProduces(TMVCMediaType.TEXT_CSV)]
|
|
// RESTful API, requires ACCEPT=text/csv
|
|
procedure ExportPeopleListAsCSV_API;
|
|
|
|
[MVCPath('/people/formats/csv')]
|
|
[MVCHTTPMethods([httpGET])]
|
|
// Route usable by the browser, doesn't requires ACCEPT=text/csv
|
|
procedure ExportPeopleListAsCSV;
|
|
|
|
[MVCPath('/people')]
|
|
[MVCHTTPMethods([httpPOST])]
|
|
[MVCConsumes(TMVCMediaType.APPLICATION_FORM_URLENCODED)]
|
|
procedure SavePerson(const [MVCFromBody] Person: TPerson);
|
|
|
|
[MVCPath('/deleteperson')]
|
|
[MVCHTTPMethods([httpPOST])]
|
|
[MVCConsumes(TMVCMediaType.APPLICATION_FORM_URLENCODED)]
|
|
procedure DeletePerson;
|
|
|
|
[MVCPath('/new')]
|
|
[MVCHTTPMethods([httpGET])]
|
|
[MVCProduces(TMVCMediaType.TEXT_HTML)]
|
|
procedure NewPerson;
|
|
|
|
[MVCPath('/edit/($guid)')]
|
|
[MVCHTTPMethods([httpGET])]
|
|
[MVCProduces(TMVCMediaType.TEXT_HTML)]
|
|
procedure EditPerson(guid: string);
|
|
|
|
[MVCPath('/')]
|
|
[MVCHTTPMethods([httpGET])]
|
|
[MVCProduces(TMVCMediaType.TEXT_HTML)]
|
|
procedure Index;
|
|
|
|
[MVCPath('/showcase')]
|
|
[MVCHTTPMethods([httpGET])]
|
|
[MVCProduces(TMVCMediaType.TEXT_HTML)]
|
|
procedure SempareTemplateShowCase;
|
|
end;
|
|
|
|
type
|
|
TSelectedDevice = record
|
|
name: string;
|
|
selected: Boolean;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses System.Rtti, System.SysUtils, Web.HTTPApp;
|
|
|
|
function GetSelectedDevices(const ADevices: TArray<string>; const AUserDevices: TArray<string>): TArray<TSelectedDevice>;
|
|
var
|
|
i: integer;
|
|
LDevice: string;
|
|
LDevices: TArray<string>;
|
|
begin
|
|
LDevices := ADevices;
|
|
setlength(result, length(ADevices));
|
|
TArray.Sort<string>(LDevices);
|
|
for i := Low(LDevices) to High(LDevices) do
|
|
begin
|
|
result[i].name := ADevices[i];
|
|
result[i].selected := false;
|
|
end;
|
|
for LDevice in AUserDevices do
|
|
begin
|
|
if TArray.BinarySearch<String>(LDevices, LDevice, i) then
|
|
result[i].selected := true;
|
|
end;
|
|
end;
|
|
|
|
function GetSelectedDevicesValue(const ADevices: TArray<string>; const AUserDevices: TArray<string>): TValue;
|
|
begin
|
|
exit(TValue.From < TArray < TSelectedDevice >> (GetSelectedDevices(ADevices, AUserDevices)));
|
|
end;
|
|
|
|
{ TWebSiteController }
|
|
|
|
procedure TWebSiteController.DeletePerson;
|
|
var
|
|
lGUID: string;
|
|
LDAL: IPeopleDAL;
|
|
begin
|
|
lGUID := Context.Request.Params['guid'];
|
|
LDAL := TServicesFactory.GetPeopleDAL;
|
|
LDAL.DeleteByGUID(lGUID);
|
|
Redirect('/people');
|
|
end;
|
|
|
|
procedure TWebSiteController.EditPerson(guid: string);
|
|
var
|
|
LDAL: IPeopleDAL;
|
|
lPerson: TPerson;
|
|
begin
|
|
LDAL := TServicesFactory.GetPeopleDAL;
|
|
lPerson := LDAL.GetPersonByGUID(guid);
|
|
try
|
|
ViewData['person'] := lPerson;
|
|
ViewData['devices'] := GetSelectedDevicesValue(LDAL.GetDevicesList, lPerson.Devices);
|
|
LoadView(['editperson']);
|
|
RenderResponseStream;
|
|
finally
|
|
lPerson.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSiteController.ExportPeopleListAsCSV;
|
|
begin
|
|
GeneratePeopleListAsCSV;
|
|
// define the correct behaviour to download the csv inside the browser
|
|
ContentType := TMVCMediaType.TEXT_CSV;
|
|
Context.Response.CustomHeaders.Values['Content-Disposition'] := 'attachment; filename=people.csv';
|
|
end;
|
|
|
|
procedure TWebSiteController.ExportPeopleListAsCSV_API;
|
|
begin
|
|
GeneratePeopleListAsCSV;
|
|
end;
|
|
|
|
procedure TWebSiteController.GeneratePeopleListAsCSV;
|
|
var
|
|
LDAL: IPeopleDAL;
|
|
lPeople: TPeople;
|
|
begin
|
|
LDAL := TServicesFactory.GetPeopleDAL;
|
|
lPeople := LDAL.GetPeople;
|
|
try
|
|
ViewData['people'] := lPeople;
|
|
LoadView(['people_list.csv']);
|
|
RenderResponseStream;
|
|
finally
|
|
lPeople.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSiteController.Index;
|
|
begin
|
|
Redirect('/people');
|
|
end;
|
|
|
|
procedure TWebSiteController.SempareTemplateShowCase;
|
|
var
|
|
LDAL: IPeopleDAL;
|
|
lPeople, lPeople2: TPeople;
|
|
lMyObj: TMyObj;
|
|
begin
|
|
LDAL := TServicesFactory.GetPeopleDAL;
|
|
lPeople := nil;
|
|
lPeople2 := nil;
|
|
lMyObj := nil;
|
|
try
|
|
lPeople := LDAL.GetPeople;
|
|
lPeople2 := TObjectList<TPerson>.Create;
|
|
lMyObj := TMyObj.Create;
|
|
lMyObj.RawHTML := '<h1>This is</h1>Raw<br><span>HTML</span>';
|
|
ViewData['people'] := lPeople;
|
|
ViewData['people2'] := lPeople2;
|
|
ViewData['myobj'] := lMyObj;
|
|
LoadView(['showcase']);
|
|
RenderResponseStream;
|
|
finally
|
|
lMyObj.Free;
|
|
lPeople2.Free;
|
|
lPeople.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSiteController.NewPerson;
|
|
var
|
|
LDAL: IPeopleDAL;
|
|
begin
|
|
LDAL := TServicesFactory.GetPeopleDAL;
|
|
ViewData['devices'] := GetSelectedDevicesValue(LDAL.GetDevicesList, nil);
|
|
LoadView(['editperson']);
|
|
RenderResponseStream;
|
|
end;
|
|
|
|
procedure TWebSiteController.OnBeforeAction(Context: TWebContext; const AActionNAme: string; var Handled: Boolean);
|
|
begin
|
|
inherited;
|
|
ContentType := 'text/html';
|
|
Handled := false;
|
|
end;
|
|
|
|
procedure TWebSiteController.PeopleList;
|
|
var
|
|
LDAL: IPeopleDAL;
|
|
lPeople: TPeople;
|
|
begin
|
|
LDAL := TServicesFactory.GetPeopleDAL;
|
|
lPeople := LDAL.GetPeople;
|
|
try
|
|
ViewData['people'] := lPeople;
|
|
LoadView(['people_list']);
|
|
RenderResponseStream;
|
|
finally
|
|
lPeople.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TWebSiteController.SavePerson(const [MVCFromBody] Person: TPerson);
|
|
var
|
|
LPeopleDAL: IPeopleDAL;
|
|
begin
|
|
if Person.FirstName.IsEmpty or Person.LastName.IsEmpty or (Person.Age <= 0) then
|
|
begin
|
|
{ TODO -oDaniele -cGeneral : Show how to properly render an exception }
|
|
raise EMVCException.Create('Invalid data', 'First name, last name and age are not optional', 0);
|
|
end;
|
|
|
|
LPeopleDAL := TServicesFactory.GetPeopleDAL;
|
|
LPeopleDAL.AddPerson(Person.FirstName, Person.LastName, Person.Age, Person.Devices);
|
|
Redirect('/people');
|
|
end;
|
|
|
|
end.
|