[tools 1/2] testbot/cgi: Group related CGI framework methods together.
Signed-off-by: Francois Gouget <fgouget(a)codeweavers.com> --- This should not make any difference to the way the website works but it really makes it easier to understand how the classes work. It also simplifies documenting them. --- .../lib/ObjectModel/CGI/CollectionBlock.pm | 668 +++++++++--------- .../ObjectModel/CGI/CollectionBlockForPage.pm | 87 ++- testbot/lib/ObjectModel/CGI/CollectionPage.pm | 152 ++-- testbot/lib/ObjectModel/CGI/FormPage.pm | 331 +++++---- testbot/lib/ObjectModel/CGI/ItemPage.pm | 136 ++-- testbot/lib/ObjectModel/CGI/Page.pm | 156 ++-- testbot/lib/WineTestBot/CGI/PageBase.pm | 355 +++++----- 7 files changed, 1024 insertions(+), 861 deletions(-) diff --git a/testbot/lib/ObjectModel/CGI/CollectionBlock.pm b/testbot/lib/ObjectModel/CGI/CollectionBlock.pm index 9027b8775..13bbc4c3f 100644 --- a/testbot/lib/ObjectModel/CGI/CollectionBlock.pm +++ b/testbot/lib/ObjectModel/CGI/CollectionBlock.pm @@ -51,6 +51,20 @@ sub _initialize($$$) #my ($self, $Collection, $EnclosingPage) = @_; } +sub CallGetDetailsPage($) +{ + my ($self) = @_; + + return $self->GetDetailsPage(); +} + +sub GetDetailsPage($) +{ + my ($self) = @_; + + return $self->{Collection}->GetItemName() . "Details.pl"; +} + sub escapeHTML($$) { my ($self, $String) = @_; @@ -58,126 +72,213 @@ sub escapeHTML($$) return $self->{EnclosingPage}->escapeHTML($String); } -sub GenerateList($) + +# +# Error handling framework +# + +sub CallGenerateErrorDiv($) { my ($self) = @_; - my $Collection = $self->{Collection}; - my $PropertyDescriptors = $Collection->GetPropertyDescriptors(); - my $HasDT = !1; - foreach my $PropertyDescriptor (@{$PropertyDescriptors}) + $self->{EnclosingPage}->GenerateErrorDiv(); +} + +sub CallGenerateErrorPopup($) +{ + my ($self) = @_; + + $self->{EnclosingPage}->GenerateErrorPopup(); +} + + +# +# Individual item property support +# + +sub CallDisplayProperty($$) +{ + my ($self, $PropertyDescriptor) = @_; + + return $self->DisplayProperty($PropertyDescriptor); +} + +sub DisplayProperty($$) +{ + my ($self, $PropertyDescriptor) = @_; + + return $PropertyDescriptor->GetClass ne "Detailref"; +} + +sub CallSortKeys($$) +{ + my ($self, $Keys) = @_; + + return $self->SortKeys($Keys); +} + +sub SortKeys($$) +{ + my ($self, $Keys) = @_; + + return $Keys; +} + +sub CallGetDisplayValue($$$) +{ + my ($self, $Item, $PropertyDescriptor) = @_; + + return $self->GetDisplayValue($Item, $PropertyDescriptor); +} + +sub GetDisplayValue($$$) +{ + my ($self, $Item, $PropertyDescriptor) = @_; + + my $PropertyName = $PropertyDescriptor->GetName(); + my $Value = $Item->$PropertyName; + + if ($PropertyDescriptor->GetClass() eq "Itemref") { - if ($PropertyDescriptor->GetClass() eq "Basic" && - $PropertyDescriptor->GetType() eq "DT") + if (defined($Value)) { - $HasDT = 1; + foreach $PropertyDescriptor (@{$Value->GetPropertyDescriptors()}) + { + if ($PropertyDescriptor->GetIsKey()) + { + $PropertyName = $PropertyDescriptor->GetName(); + $Value = $Value->$PropertyName; + last; + } + } } } - if ($HasDT) + + if ($PropertyDescriptor->GetClass() eq "Basic") { - print <<"EOF"; -<script type='text/javascript'><!--\ -function Pad2(n) + if ($PropertyDescriptor->GetType() eq "B") + { + $Value = ($Value ? "Yes" : "No"); + } + elsif ($PropertyDescriptor->GetType() eq "DT") + { + if (defined($Value)) + { + $Value = + "<noscript><div>" . + strftime("%Y-%m-%d %H:%M:%S", localtime($Value)) . "</div></noscript>\n" . +"<script type='text/javascript'><!--\n" . + "ShowDateTime($Value);\n" . + "//--></script>\n"; + } + } + } + + return $Value; +} + +sub CallGetEscapedDisplayValue($$$) { - return n < 10 ? '0' + n : n; + my ($self, $Item, $PropertyDescriptor) = @_; + + return $self->GetEscapedDisplayValue($Item, $PropertyDescriptor); } -function ShowDateTime(Sec1970, Id, Attr) +sub GetEscapedDisplayValue($$$) { - var Dt = new Date(Sec1970 * 1000); - var Pretty = Dt.getFullYear() + '-' + Pad2(Dt.getMonth() + 1) + '-' + - Pad2(Dt.getDate()) + ' ' + Pad2(Dt.getHours()) + ':' + - Pad2(Dt.getMinutes()) + ':' + Pad2(Dt.getSeconds()) - if (Id != null) + my ($self, $Item, $PropertyDescriptor) = @_; + + my $PropertyName = $PropertyDescriptor->GetName(); + my $Value = $Item->$PropertyName; + + if ($PropertyDescriptor->GetClass() eq "Basic" && + $PropertyDescriptor->GetType() eq "DT") { - document.getElementById(Id).setAttribute(Attr || "title", Pretty); + if (defined($Value)) + { + $Value = "<script type='text/javascript'><!--\n" . + "ShowDateTime($Value);\n" . + "//--></script><noscript><div>" . + strftime("%Y-%m-%d %H:%M:%S", localtime($Value)) . + "</div></noscript>\n"; + } } else { - document.write(Pretty); + $Value = $self->escapeHTML($self->CallGetDisplayValue($Item, + $PropertyDescriptor)); } + + return $Value; } -//--></script> -EOF - } - print "<div class='CollectionBlock'>\n"; - $self->CallGenerateFormStart(); - $self->CallGenerateErrorDiv(); - print "<table border='0' cellpadding='5' cellspacing='0' summary='" . - "Overview of " . $Collection->GetCollectionName() . "'>\n"; - print "<thead>\n"; - my $ItemActions = $self->CallGetItemActions(); - $self->CallGenerateHeaderRow($PropertyDescriptors, $ItemActions); - print "</thead>\n"; +# +# Item cell generation +# - print "<tbody>\n"; - my $DetailsPage = $self->CallGetDetailsPage(); - my $Row = 0; - my $Keys = $self->CallSortKeys($self->{Collection}->GetKeys()); - foreach my $Key (@$Keys) - { - my $Class = ($Row % 2) == 0 ? "even" : "odd"; - my $Item = $self->{Collection}->GetItem($Key); - $self->CallGenerateDataRow($Item, $PropertyDescriptors, $DetailsPage, - $Class, $ItemActions); - $Row++; - } - if (@$Keys == 0) - { - print "<tr class='even'><td colspan='0'>No entries</td></tr>\n"; - } +sub CallGenerateHeaderCell($$) +{ + my ($self, $PropertyDescriptor) = @_; - print "</tbody>\n"; - print "</table>\n"; + return $self->GenerateHeaderCell($PropertyDescriptor); +} - if (@$ItemActions != 0 && @$Keys != 0) - { - print <<EOF; -<div class='CollectionBlockActions'> -<script type='text/javascript'> -<!-- -function ToggleAll() +sub GenerateHeaderCell($$) { - for (var i = 0; i < document.forms[0].elements.length; i++) - { - if(document.forms[0].elements[i].type == 'checkbox') - document.forms[0].elements[i].checked = !(document.forms[0].elements[i].checked); - } + my ($self, $PropertyDescriptor) = @_; + print "<th>", $self->escapeHTML($PropertyDescriptor->GetDisplayName()), + "</th>\n"; } -// Only put javascript link in document if javascript is enabled -document.write("<a href='javascript:void(0)' onClick='ToggleAll();'>Toggle All<\\\/a> "); -//--> -</script> -EOF - print "For selected ", $self->{Collection}->GetCollectionName() . ":"; - foreach my $Action (@$ItemActions) - { - print " <input type='submit' name='Action' value='" . - $self->escapeHTML($Action) . "' />"; - } - print "\n"; - print "</div>\n"; - } +sub CallGenerateDataCell($$$$) +{ + my ($self, $Item, $PropertyDescriptor, $DetailsPage) = @_; - my $Actions = $self->CallGetActions(); - if (@$Actions != 0) + return $self->GenerateDataCell($Item, $PropertyDescriptor, $DetailsPage); +} + +sub GenerateDataCell($$$$) +{ + my ($self, $Item, $PropertyDescriptor, $DetailsPage) = @_; + + print "<td>"; + my $NeedLink; + if ($PropertyDescriptor->GetIsKey() && $DetailsPage) { - print "<div class='CollectionBlockActions'>\n"; - foreach my $Action (@$Actions) + $NeedLink = 1; + } + else + { + $NeedLink = !1; + } + if ($NeedLink) + { + my $Query = "$DetailsPage?Key=" . uri_escape($Item->GetKey()); + my ($MasterColNames, $MasterColValues) = $Item->GetMasterCols(); + if (defined($MasterColNames)) { - print "<input type='submit' name='Action' value='$Action' />\n"; + foreach my $ColIndex (0 .. @$MasterColNames - 1) + { + $Query .= "&" . $MasterColNames->[$ColIndex] . "=" . + uri_escape($MasterColValues->[$ColIndex]); + } } - print "</div>\n"; + print "<a href='", $self->escapeHTML($Query), "'>"; } - - $self->CallGenerateErrorPopup(undef); - $self->CallGenerateFormEnd(); - print "</div>\n"; + print $self->CallGetEscapedDisplayValue($Item, $PropertyDescriptor); + if ($NeedLink) + { + print "</a>"; + } + print "</td>\n"; } + +# +# Collection table generation +# + sub CallGenerateFormStart($) { my ($self) = @_; @@ -202,33 +303,6 @@ sub GenerateFormStart($) } } -sub CallGenerateErrorDiv($) -{ - my ($self) = @_; - - $self->{EnclosingPage}->GenerateErrorDiv(); -} - -sub CallGenerateErrorPopup($) -{ - my ($self) = @_; - - $self->{EnclosingPage}->GenerateErrorPopup(); -} - -sub CallGenerateFormEnd($) -{ - my ($self) = @_; - - $self->GenerateFormEnd(); -} - -sub GenerateFormEnd($) -{ - #my ($self) = @_; - print "</form>\n"; -} - sub CallGenerateHeaderRow($$$) { my ($self, $PropertyDescriptors, $ItemActions) = @_; @@ -256,18 +330,12 @@ sub GenerateHeaderRow($$$) print "</tr>\n"; } -sub CallGenerateHeaderCell($$) +sub SelName($$) { - my ($self, $PropertyDescriptor) = @_; - - return $self->GenerateHeaderCell($PropertyDescriptor); -} + my ($self, $Key) = @_; -sub GenerateHeaderCell($$) -{ - my ($self, $PropertyDescriptor) = @_; - print "<th>", $self->escapeHTML($PropertyDescriptor->GetDisplayName()), - "</th>\n"; + $Key =~ s/[^0-9a-zA-Z]+/_/g; + return "sel_" . $Key; } sub CallGenerateDataRow($$$$$$) @@ -277,14 +345,6 @@ sub CallGenerateDataRow($$$$$$) $self->GenerateDataRow($Item, $PropertyDescriptors, $DetailsPage, $Class, $ItemActions); } -sub SelName($$) -{ - my ($self, $Key) = @_; - - $Key =~ s/[^0-9a-zA-Z]+/_/g; - return "sel_" . $Key; -} - sub GenerateDataRow($$$$$$) { my ($self, $Item, $PropertyDescriptors, $DetailsPage, $Class, $ItemActions) = @_; @@ -295,72 +355,153 @@ sub GenerateDataRow($$$$$$) print "<td><input name='", $self->SelName($Item->GetKey()), "' type='checkbox' /></td>\n"; } - foreach my $PropertyDescriptor (@$PropertyDescriptors) + foreach my $PropertyDescriptor (@$PropertyDescriptors) + { + if ($self->CallDisplayProperty($PropertyDescriptor)) + { + $self->CallGenerateDataCell($Item, $PropertyDescriptor, $DetailsPage); + } + } + print "</tr>\n"; +} + +sub CallGenerateFormEnd($) +{ + my ($self) = @_; + + $self->GenerateFormEnd(); +} + +sub GenerateFormEnd($) +{ + #my ($self) = @_; + print "</form>\n"; +} + +sub GenerateList($) +{ + my ($self) = @_; + + my $Collection = $self->{Collection}; + my $PropertyDescriptors = $Collection->GetPropertyDescriptors(); + my $HasDT = !1; + foreach my $PropertyDescriptor (@{$PropertyDescriptors}) + { + if ($PropertyDescriptor->GetClass() eq "Basic" && + $PropertyDescriptor->GetType() eq "DT") + { + $HasDT = 1; + } + } + if ($HasDT) + { + print <<"EOF"; +<script type='text/javascript'><!--\ +function Pad2(n) +{ + return n < 10 ? '0' + n : n; +} + +function ShowDateTime(Sec1970, Id, Attr) +{ + var Dt = new Date(Sec1970 * 1000); + var Pretty = Dt.getFullYear() + '-' + Pad2(Dt.getMonth() + 1) + '-' + + Pad2(Dt.getDate()) + ' ' + Pad2(Dt.getHours()) + ':' + + Pad2(Dt.getMinutes()) + ':' + Pad2(Dt.getSeconds()) + if (Id != null) + { + document.getElementById(Id).setAttribute(Attr || "title", Pretty); + } + else + { + document.write(Pretty); + } +} +//--></script> +EOF + } + + print "<div class='CollectionBlock'>\n"; + $self->CallGenerateFormStart(); + $self->CallGenerateErrorDiv(); + + print "<table border='0' cellpadding='5' cellspacing='0' summary='" . + "Overview of " . $Collection->GetCollectionName() . "'>\n"; + print "<thead>\n"; + my $ItemActions = $self->CallGetItemActions(); + $self->CallGenerateHeaderRow($PropertyDescriptors, $ItemActions); + print "</thead>\n"; + + print "<tbody>\n"; + my $DetailsPage = $self->CallGetDetailsPage(); + my $Row = 0; + my $Keys = $self->CallSortKeys($self->{Collection}->GetKeys()); + foreach my $Key (@$Keys) + { + my $Class = ($Row % 2) == 0 ? "even" : "odd"; + my $Item = $self->{Collection}->GetItem($Key); + $self->CallGenerateDataRow($Item, $PropertyDescriptors, $DetailsPage, + $Class, $ItemActions); + $Row++; + } + if (@$Keys == 0) { - if ($self->CallDisplayProperty($PropertyDescriptor)) - { - $self->CallGenerateDataCell($Item, $PropertyDescriptor, $DetailsPage); - } + print "<tr class='even'><td colspan='0'>No entries</td></tr>\n"; } - print "</tr>\n"; -} - -sub CallGenerateDataCell($$$$) -{ - my ($self, $Item, $PropertyDescriptor, $DetailsPage) = @_; - return $self->GenerateDataCell($Item, $PropertyDescriptor, $DetailsPage); -} - -sub GenerateDataCell($$$$) -{ - my ($self, $Item, $PropertyDescriptor, $DetailsPage) = @_; + print "</tbody>\n"; + print "</table>\n"; - print "<td>"; - my $NeedLink; - if ($PropertyDescriptor->GetIsKey() && $DetailsPage) + if (@$ItemActions != 0 && @$Keys != 0) { - $NeedLink = 1; - } - else + print <<EOF; +<div class='CollectionBlockActions'> +<script type='text/javascript'> +<!-- +function ToggleAll() +{ + for (var i = 0; i < document.forms[0].elements.length; i++) { - $NeedLink = !1; + if(document.forms[0].elements[i].type == 'checkbox') + document.forms[0].elements[i].checked = !(document.forms[0].elements[i].checked); } - if ($NeedLink) - { - my $Query = "$DetailsPage?Key=" . uri_escape($Item->GetKey()); - my ($MasterColNames, $MasterColValues) = $Item->GetMasterCols(); - if (defined($MasterColNames)) +} + +// Only put javascript link in document if javascript is enabled +document.write("<a href='javascript:void(0)' onClick='ToggleAll();'>Toggle All<\\\/a> "); +//--> +</script> +EOF + print "For selected ", $self->{Collection}->GetCollectionName() . ":"; + foreach my $Action (@$ItemActions) { - foreach my $ColIndex (0 .. @$MasterColNames - 1) - { - $Query .= "&" . $MasterColNames->[$ColIndex] . "=" . - uri_escape($MasterColValues->[$ColIndex]); - } + print " <input type='submit' name='Action' value='" . + $self->escapeHTML($Action) . "' />"; } - print "<a href='", $self->escapeHTML($Query), "'>"; + print "\n"; + print "</div>\n"; } - print $self->CallGetEscapedDisplayValue($Item, $PropertyDescriptor); - if ($NeedLink) + + my $Actions = $self->CallGetActions(); + if (@$Actions != 0) { - print "</a>"; + print "<div class='CollectionBlockActions'>\n"; + foreach my $Action (@$Actions) + { + print "<input type='submit' name='Action' value='$Action' />\n"; + } + print "</div>\n"; } - print "</td>\n"; -} - -sub CallGetDetailsPage($) -{ - my ($self) = @_; - return $self->GetDetailsPage(); + $self->CallGenerateErrorPopup(undef); + $self->CallGenerateFormEnd(); + print "</div>\n"; } -sub GetDetailsPage($) -{ - my ($self) = @_; - return $self->{Collection}->GetItemName() . "Details.pl"; -} +# +# Per-item actions handling +# sub CallGetItemActions($) { @@ -388,6 +529,32 @@ sub GetItemActions($) return ["Delete"]; } +sub CallOnItemAction($$$) +{ + my ($self, $Item, $Action) = @_; + + return $self->OnItemAction($Item, $Action); +} + +sub OnItemAction($$$) +{ + my ($self, $Item, $Action) = @_; + + if ($Action eq "Delete") + { + my $ErrMessage = $self->{Collection}->DeleteItem($Item); + $self->{EnclosingPage}->{ErrMessage} = $ErrMessage; + return ! defined($ErrMessage); + } + + return 1; +} + + +# +# Actions handling +# + sub CallGetActions($) { my ($self) = @_; @@ -421,108 +588,6 @@ sub GetActions($) return \@Actions; } -sub CallDisplayProperty($$) -{ - my ($self, $PropertyDescriptor) = @_; - - return $self->DisplayProperty($PropertyDescriptor); -} - -sub DisplayProperty($$) -{ - my ($self, $PropertyDescriptor) = @_; - - return $PropertyDescriptor->GetClass ne "Detailref"; -} - -sub CallGetDisplayValue($$$) -{ - my ($self, $Item, $PropertyDescriptor) = @_; - - return $self->GetDisplayValue($Item, $PropertyDescriptor); -} - -sub GetDisplayValue($$$) -{ - my ($self, $Item, $PropertyDescriptor) = @_; - - my $PropertyName = $PropertyDescriptor->GetName(); - my $Value = $Item->$PropertyName; - - if ($PropertyDescriptor->GetClass() eq "Itemref") - { - if (defined($Value)) - { - foreach $PropertyDescriptor (@{$Value->GetPropertyDescriptors()}) - { - if ($PropertyDescriptor->GetIsKey()) - { - $PropertyName = $PropertyDescriptor->GetName(); - $Value = $Value->$PropertyName; - last; - } - } - } - } - - if ($PropertyDescriptor->GetClass() eq "Basic") - { - if ($PropertyDescriptor->GetType() eq "B") - { - $Value = ($Value ? "Yes" : "No"); - } - elsif ($PropertyDescriptor->GetType() eq "DT") - { - if (defined($Value)) - { - $Value = - "<noscript><div>" . - strftime("%Y-%m-%d %H:%M:%S", localtime($Value)) . "</div></noscript>\n" . -"<script type='text/javascript'><!--\n" . - "ShowDateTime($Value);\n" . - "//--></script>\n"; - } - } - } - - return $Value; -} - -sub CallGetEscapedDisplayValue($$$) -{ - my ($self, $Item, $PropertyDescriptor) = @_; - - return $self->GetEscapedDisplayValue($Item, $PropertyDescriptor); -} - -sub GetEscapedDisplayValue($$$) -{ - my ($self, $Item, $PropertyDescriptor) = @_; - - my $PropertyName = $PropertyDescriptor->GetName(); - my $Value = $Item->$PropertyName; - - if ($PropertyDescriptor->GetClass() eq "Basic" && - $PropertyDescriptor->GetType() eq "DT") - { - if (defined($Value)) - { - $Value = "<script type='text/javascript'><!--\n" . - "ShowDateTime($Value);\n" . - "//--></script><noscript><div>" . - strftime("%Y-%m-%d %H:%M:%S", localtime($Value)) . - "</div></noscript>\n"; - } - } - else - { - $Value = $self->escapeHTML($self->CallGetDisplayValue($Item, - $PropertyDescriptor)); - } - - return $Value; -} - sub OnAction($$) { my ($self, $Action) = @_; @@ -553,39 +618,4 @@ sub OnAction($$) } } -sub CallOnItemAction($$$) -{ - my ($self, $Item, $Action) = @_; - - return $self->OnItemAction($Item, $Action); -} - -sub OnItemAction($$$) -{ - my ($self, $Item, $Action) = @_; - - if ($Action eq "Delete") - { - my $ErrMessage = $self->{Collection}->DeleteItem($Item); - $self->{EnclosingPage}->{ErrMessage} = $ErrMessage; - return ! defined($ErrMessage); - } - - return 1; -} - -sub CallSortKeys($$) -{ - my ($self, $Keys) = @_; - - return $self->SortKeys($Keys); -} - -sub SortKeys($$) -{ - my ($self, $Keys) = @_; - - return $Keys; -} - 1; diff --git a/testbot/lib/ObjectModel/CGI/CollectionBlockForPage.pm b/testbot/lib/ObjectModel/CGI/CollectionBlockForPage.pm index 13ad5a875..94d5f8672 100644 --- a/testbot/lib/ObjectModel/CGI/CollectionBlockForPage.pm +++ b/testbot/lib/ObjectModel/CGI/CollectionBlockForPage.pm @@ -31,39 +31,49 @@ use ObjectModel::CGI::CollectionBlock; our @ISA = qw(ObjectModel::CGI::CollectionBlock); -sub CallGenerateFormStart($) +sub CallGetDetailsPage($) { my ($self) = @_; - $self->{EnclosingPage}->GenerateFormStart($self); + return $self->{EnclosingPage}->GetDetailsPage($self); } -sub CallGenerateFormEnd($) + +# +# Item properties support +# + +sub CallDisplayProperty($$) { - my ($self) = @_; + my ($self, $PropertyDescriptor) = @_; - $self->{EnclosingPage}->GenerateFormEnd($self); + return $self->{EnclosingPage}->DisplayProperty($self, $PropertyDescriptor); } -sub CallGenerateHeaderCell($$) +sub CallSortKeys($$) { - my ($self, $PropertyDescriptor) = @_; + my ($self, $Keys) = @_; - return $self->{EnclosingPage}->GenerateHeaderCell($self, $PropertyDescriptor); + return $self->{EnclosingPage}->SortKeys($self, $Keys); } -sub CallGenerateHeaderRow($$$) +sub CallGetDisplayValue($$$) { - my ($self, $PropertyDescriptors, $ItemActions) = @_; + my ($self, $Item, $PropertyDescriptor) = @_; - $self->{EnclosingPage}->GenerateHeaderRow($self, $PropertyDescriptors, $ItemActions); + return $self->{EnclosingPage}->GetDisplayValue($self, $Item, $PropertyDescriptor); } -sub CallGenerateDataRow($$$$$$) + +# +# Item cell generation +# + +sub CallGenerateHeaderCell($$) { - my ($self, $Item, $PropertyDescriptors, $DetailsPage, $Class, $ItemActions) = @_; + my ($self, $PropertyDescriptor) = @_; - $self->{EnclosingPage}->GenerateDataRow($self, $Item, $PropertyDescriptors, $DetailsPage, $Class, $ItemActions); + return $self->{EnclosingPage}->GenerateHeaderCell($self, $PropertyDescriptor); } sub CallGenerateDataCell($$$$) @@ -73,39 +83,49 @@ sub CallGenerateDataCell($$$$) return $self->{EnclosingPage}->GenerateDataCell($self, $Item, $PropertyDescriptor, $DetailsPage); } -sub CallGetDetailsPage($) + +# +# Collection table generation +# + +sub CallGenerateFormStart($) { my ($self) = @_; - return $self->{EnclosingPage}->GetDetailsPage($self); + $self->{EnclosingPage}->GenerateFormStart($self); } -sub CallGetItemActions($) +sub CallGenerateHeaderRow($$$) { - my ($self) = @_; + my ($self, $PropertyDescriptors, $ItemActions) = @_; - return $self->{EnclosingPage}->GetItemActions($self); + $self->{EnclosingPage}->GenerateHeaderRow($self, $PropertyDescriptors, $ItemActions); } -sub CallGetActions($) +sub CallGenerateDataRow($$$$$$) { - my ($self) = @_; + my ($self, $Item, $PropertyDescriptors, $DetailsPage, $Class, $ItemActions) = @_; - return $self->{EnclosingPage}->GetActions($self); + $self->{EnclosingPage}->GenerateDataRow($self, $Item, $PropertyDescriptors, $DetailsPage, $Class, $ItemActions); } -sub CallDisplayProperty($$) +sub CallGenerateFormEnd($) { - my ($self, $PropertyDescriptor) = @_; + my ($self) = @_; - return $self->{EnclosingPage}->DisplayProperty($self, $PropertyDescriptor); + $self->{EnclosingPage}->GenerateFormEnd($self); } -sub CallGetDisplayValue($$$) + +# +# Per-item actions handling +# + +sub CallGetItemActions($) { - my ($self, $Item, $PropertyDescriptor) = @_; + my ($self) = @_; - return $self->{EnclosingPage}->GetDisplayValue($self, $Item, $PropertyDescriptor); + return $self->{EnclosingPage}->GetItemActions($self); } sub CallOnItemAction($$$) @@ -115,11 +135,16 @@ sub CallOnItemAction($$$) return $self->{EnclosingPage}->OnItemAction($self, $Item, $Action); } -sub CallSortKeys($$) + +# +# Actions handling +# + +sub CallGetActions($) { - my ($self, $Keys) = @_; + my ($self) = @_; - return $self->{EnclosingPage}->SortKeys($self, $Keys); + return $self->{EnclosingPage}->GetActions($self); } 1; diff --git a/testbot/lib/ObjectModel/CGI/CollectionPage.pm b/testbot/lib/ObjectModel/CGI/CollectionPage.pm index 72bba1bc4..993f18685 100644 --- a/testbot/lib/ObjectModel/CGI/CollectionPage.pm +++ b/testbot/lib/ObjectModel/CGI/CollectionPage.pm @@ -42,58 +42,51 @@ sub _initialize($$$$) $self->SUPER::_initialize($Request, $RequiredRole); } -sub GeneratePage($) +sub CreateCollectionBlock($$) { - my ($self) = @_; - - if ($self->GetParam("Action")) - { - my $CollectionBlock = $self->CreateCollectionBlock($self->{Collection}); - $self->{ActionPerformed} = $self->OnAction($CollectionBlock, - $self->GetParam("Action")); - } + my ($self, $Collection) = @_; - $self->SUPER::GeneratePage(); + return ObjectModel::CGI::CollectionBlockForPage->new($Collection, $self); } -sub GenerateTitle($) +sub GetDetailsPage($$) { - my ($self) = @_; + my ($self, $CollectionBlock) = @_; - my $Title = $self->GetTitle(); - if ($Title) - { - print "<h1 id='PageTitle'>", $self->escapeHTML($Title), "</h1>\n"; - } + return $CollectionBlock->GetDetailsPage(); } -sub GenerateBody($) + +# +# Item properties support +# + +sub DisplayProperty($$$) { - my ($self) = @_; + my ($self, $CollectionBlock, $PropertyDescriptor) = @_; - print "<div class='CollectionPageBody'>\n"; - $self->GenerateTitle(); - print "<div class='Content'>\n"; - my $CollectionBlock = $self->CreateCollectionBlock($self->{Collection}); - $CollectionBlock->GenerateList(); - print "</div>\n"; - print "</div>\n"; + return $CollectionBlock->DisplayProperty($PropertyDescriptor); } -sub GenerateFormStart($$) +sub SortKeys($$$) { - my ($self, $CollectionBlock) = @_; + my ($self, $CollectionBlock, $Keys) = @_; - $CollectionBlock->GenerateFormStart(); + return $CollectionBlock->SortKeys($Keys); } -sub GenerateFormEnd($$) +sub GetDisplayValue($$$$) { - my ($self, $CollectionBlock) = @_; + my ($self, $CollectionBlock, $Item, $PropertyDescriptor) = @_; - $CollectionBlock->GenerateFormEnd(); + return $CollectionBlock->GetDisplayValue($Item, $PropertyDescriptor); } + +# +# Item cell generation +# + sub GenerateHeaderCell($$$) { my ($self, $CollectionBlock, $PropertyDescriptor) = @_; @@ -101,6 +94,18 @@ sub GenerateHeaderCell($$$) $CollectionBlock->GenerateHeaderCell($PropertyDescriptor); } +sub GenerateDataCell($$$$$) +{ + my ($self, $CollectionBlock, $Item, $PropertyDescriptor, $DetailsPage) = @_; + + $CollectionBlock->GenerateDataCell($Item, $PropertyDescriptor, $DetailsPage); +} + + +# +# Collection table generation +# + sub GenerateHeaderRow($$$$) { my ($self, $CollectionBlock, $PropertyDescriptors, $ItemActions) = @_; @@ -115,60 +120,80 @@ sub GenerateDataRow($$$$$$$) $CollectionBlock->GenerateDataRow($Item, $PropertyDescriptors, $DetailsPage, $Class, $ItemActions); } -sub GenerateDataCell($$$$$) + +# +# HTML page generation +# + +sub GetTitle($) { - my ($self, $CollectionBlock, $Item, $PropertyDescriptor, $DetailsPage) = @_; + my ($self) = @_; - $CollectionBlock->GenerateDataCell($Item, $PropertyDescriptor, $DetailsPage); + return ucfirst($self->{Collection}->GetCollectionName()); } -sub CreateCollectionBlock($$) +sub GenerateTitle($) { - my ($self, $Collection) = @_; + my ($self) = @_; - return ObjectModel::CGI::CollectionBlockForPage->new($Collection, $self); + my $Title = $self->GetTitle(); + if ($Title) + { + print "<h1 id='PageTitle'>", $self->escapeHTML($Title), "</h1>\n"; + } } -sub GetDetailsPage($$) +sub GenerateFormStart($$) { my ($self, $CollectionBlock) = @_; - return $CollectionBlock->GetDetailsPage(); + $CollectionBlock->GenerateFormStart(); } -sub GetTitle($) +sub GenerateBody($) { my ($self) = @_; - return ucfirst($self->{Collection}->GetCollectionName()); + print "<div class='CollectionPageBody'>\n"; + $self->GenerateTitle(); + print "<div class='Content'>\n"; + my $CollectionBlock = $self->CreateCollectionBlock($self->{Collection}); + $CollectionBlock->GenerateList(); + print "</div>\n"; + print "</div>\n"; } -sub GetItemActions($$) +sub GenerateFormEnd($$) { my ($self, $CollectionBlock) = @_; - return $CollectionBlock->GetItemActions(); + $CollectionBlock->GenerateFormEnd(); } -sub GetActions($$) +sub GeneratePage($) { - my ($self, $CollectionBlock) = @_; + my ($self) = @_; - return $CollectionBlock->GetActions(); + if ($self->GetParam("Action")) + { + my $CollectionBlock = $self->CreateCollectionBlock($self->{Collection}); + $self->{ActionPerformed} = $self->OnAction($CollectionBlock, + $self->GetParam("Action")); + } + + $self->SUPER::GeneratePage(); } -sub DisplayProperty($$$) -{ - my ($self, $CollectionBlock, $PropertyDescriptor) = @_; - return $CollectionBlock->DisplayProperty($PropertyDescriptor); -} +# +# Per-item actions handling +# -sub OnAction($$$) +sub GetItemActions($$) { - my ($self, $CollectionBlock, $Action) = @_; + my ($self, $CollectionBlock) = @_; - $CollectionBlock->OnAction($Action); + return $CollectionBlock->GetItemActions(); } sub OnItemAction($$$$) @@ -178,18 +203,23 @@ sub OnItemAction($$$$) return $CollectionBlock->OnItemAction($Item, $Action); } -sub GetDisplayValue($$$$) + +# +# Actions handling +# + +sub GetActions($$) { - my ($self, $CollectionBlock, $Item, $PropertyDescriptor) = @_; + my ($self, $CollectionBlock) = @_; - return $CollectionBlock->GetDisplayValue($Item, $PropertyDescriptor); + return $CollectionBlock->GetActions(); } -sub SortKeys($$$) +sub OnAction($$$) { - my ($self, $CollectionBlock, $Keys) = @_; + my ($self, $CollectionBlock, $Action) = @_; - return $CollectionBlock->SortKeys($Keys); + $CollectionBlock->OnAction($Action); } 1; diff --git a/testbot/lib/ObjectModel/CGI/FormPage.pm b/testbot/lib/ObjectModel/CGI/FormPage.pm index bc8ce478c..588ea55b7 100644 --- a/testbot/lib/ObjectModel/CGI/FormPage.pm +++ b/testbot/lib/ObjectModel/CGI/FormPage.pm @@ -44,6 +44,11 @@ sub _initialize($$$$) $self->{Method} = "post"; } + +# +# Property handling +# + sub GetPropertyDescriptors($) { my ($self) = @_; @@ -67,121 +72,42 @@ sub GetPropertyDescriptorByName($$) return undef; } -sub GeneratePage($) -{ - my ($self) = @_; - - if ($self->GetParam("Action")) - { - $self->{ActionPerformed} = $self->OnAction($self->GetParam("Action")); - } - - $self->SUPER::GeneratePage(); -} - -sub GenerateTitle($) -{ - my ($self) = @_; - - my $Title = $self->GetTitle(); - if ($Title) - { - print "<h1 id='PageTitle'>", $self->CGI->escapeHTML($Title), "</h1>\n"; - } -} - -sub GenerateBody($) -{ - my ($self) = @_; - - print "<div class='ItemBody'>\n"; - $self->GenerateTitle(); - print "<div class='Content'>\n"; - my $Text = $self->GetHeaderText(); - if ($Text) - { - print "<p>$Text</p>\n"; - } - $self->GenerateFormStart(); - $self->GenerateErrorDiv(); - - $self->GenerateFields(); - $self->GenerateRequiredLegend(); - - if (defined $self->{ErrMessage}) - { - if (defined $self->{ErrField}) - { - my $PropertyDescriptor = $self->GetPropertyDescriptorByName($self->{ErrField}); - if ($PropertyDescriptor and !$self->DisplayProperty($PropertyDescriptor)) - { - $self->{ErrMessage} = "Internal error?\n$self->{ErrMessage}"; - } - } - $self->GenerateErrorPopup(); - } - $self->GenerateActions(); - $self->GenerateFormEnd(); - $Text = $self->GetFooterText(); - if ($Text) - { - print "<p>$Text</p>\n"; - } - print "</div><!--Content-->\n"; - print "</div><!--ItemBody-->\n"; -} - -sub GenerateFormStart($) -{ - my ($self) = @_; - print "<form action='" . $ENV{"SCRIPT_NAME"} . - "' method='$self->{Method}' enctype='multipart/form-data'>\n"; -} - -sub GenerateFields($) +sub DisplayProperty($$) { - my ($self) = @_; + my ($self, $PropertyDescriptor) = @_; - my $PropertyDescriptors = $self->GetPropertyDescriptors(); - foreach my $PropertyDescriptor (@{$PropertyDescriptors}) - { - my $Display = $self->DisplayProperty($PropertyDescriptor); - $self->GenerateField($PropertyDescriptor, $Display) if ($Display); - } + return # Detailref fields point to a Collection of objects matching the + # primary key of this form data. As such they can neither be shown + # nor edited. + $PropertyDescriptor->GetClass() eq "Detailref" ? "" : + # Itemref fields are keys identifying other objects and thus would + # require careful validation if edited. Requiring users to manually + # type the appropriate key value would also be cumbersome so this is + # currently not supported. But they can be displayed. + $PropertyDescriptor->GetClass() eq "Itemref" ? "ro" : + # All other properties can be edited... + $PropertyDescriptor->GetClass() ne "Basic" ? "rw" : + $PropertyDescriptor->GetType() ne "S" ? "rw" : + # ...except autoincrement ones (shown as <unset> if undefined) + "ro"; } -sub GenerateRequiredLegend($) +sub GetPropertyValue($$) { - my ($self) = @_; - - if ($self->{HasRequired}) - { - print "<div class='ItemProperty'><label><span class='Required'>*</span></label>Required field</div>\n"; - } + #my ($self, $PropertyDescriptor) = @_; + return undef; } -sub GenerateActions($) -{ - my ($self) = @_; - print "<div class='ItemActions'>\n"; - foreach my $Action (@{$self->GetActions()}) - { - print "<input type='submit' name='Action' value='$Action'/>\n"; - } - print "</div>\n"; -} +# +# Form field support +# -sub GenerateFormEnd($) +sub GetDisplayName($$) { - #my ($self) = @_; - print "</form>\n"; -} + my ($self, $PropertyDescriptor) = @_; -sub GetPropertyValue($$) -{ - #my ($self, $PropertyDescriptor) = @_; - return undef; + return $PropertyDescriptor->GetDisplayName(); } sub GetDisplayValue($$) @@ -197,13 +123,6 @@ sub GetDisplayValue($$) return $Value; } -sub GetDisplayName($$) -{ - my ($self, $PropertyDescriptor) = @_; - - return $PropertyDescriptor->GetDisplayName(); -} - sub GetInputType($$) { my ($self, $PropertyDescriptor) = @_; @@ -216,6 +135,17 @@ sub GetInputType($$) "text"; } +sub GenerateRequired($$) +{ + my ($self, $PropertyDescriptor) = @_; + + if ($PropertyDescriptor->GetIsRequired()) + { + $self->{HasRequired} = 1; + print " <a class='Required' title='Required field'>*</a>"; + } +} + sub GenerateField($$$) { my ($self, $PropertyDescriptor, $Display) = @_; @@ -300,27 +230,66 @@ sub GenerateField($$$) print "</div>\n"; } -sub GenerateRequired($$) + +# +# HTML form page generation +# + +sub GetTitle($) { - my ($self, $PropertyDescriptor) = @_; + #my ($self) = @_; + return undef; +} - if ($PropertyDescriptor->GetIsRequired()) +sub GenerateTitle($) +{ + my ($self) = @_; + + my $Title = $self->GetTitle(); + if ($Title) { - $self->{HasRequired} = 1; - print " <a class='Required' title='Required field'>*</a>"; + print "<h1 id='PageTitle'>", $self->CGI->escapeHTML($Title), "</h1>\n"; } } -sub GetTitle($) +sub GetHeaderText($) { #my ($self) = @_; return undef; } -sub GetHeaderText($) +sub GenerateFormStart($) +{ + my ($self) = @_; + print "<form action='" . $ENV{"SCRIPT_NAME"} . + "' method='$self->{Method}' enctype='multipart/form-data'>\n"; +} + +sub GenerateFields($) +{ + my ($self) = @_; + + foreach my $PropertyDescriptor (@{$self->GetPropertyDescriptors()}) + { + my $Display = $self->DisplayProperty($PropertyDescriptor); + $self->GenerateField($PropertyDescriptor, $Display) if ($Display); + } +} + +sub GenerateRequiredLegend($) +{ + my ($self) = @_; + + if ($self->{HasRequired}) + { + print "<div class='ItemProperty'><label><span class='Required'>*</span></label>Required field</div>\n"; + } +} + +sub GenerateFormEnd($) { #my ($self) = @_; - return undef; + print "</form>\n"; } sub GetFooterText($) @@ -329,30 +298,81 @@ sub GetFooterText($) return undef; } -sub DisplayProperty($$) +sub GenerateBody($) { - my ($self, $PropertyDescriptor) = @_; + my ($self) = @_; - return # Detailref fields point to a Collection of objects matching the - # primary key of this form data. As such they can neither be shown - # nor edited. - $PropertyDescriptor->GetClass() eq "Detailref" ? "" : - # Itemref fields are keys identifying other objects and thus would - # require careful validation if edited. Requiring users to manually - # type the appropriate key value would also be cumbersome so this is - # currently not supported. But they can be displayed. - $PropertyDescriptor->GetClass() eq "Itemref" ? "ro" : - # All other properties can be edited... - $PropertyDescriptor->GetClass() ne "Basic" ? "rw" : - $PropertyDescriptor->GetType() ne "S" ? "rw" : - # ...except autoincrement ones (shown as <unset> if undefined) - "ro"; + print "<div class='ItemBody'>\n"; + $self->GenerateTitle(); + print "<div class='Content'>\n"; + my $Text = $self->GetHeaderText(); + if ($Text) + { + print "<p>$Text</p>\n"; + } + $self->GenerateFormStart(); + $self->GenerateErrorDiv(); + + $self->GenerateFields(); + $self->GenerateRequiredLegend(); + + if (defined $self->{ErrMessage}) + { + if (defined $self->{ErrField}) + { + my $PropertyDescriptor = $self->GetPropertyDescriptorByName($self->{ErrField}); + if ($PropertyDescriptor and !$self->DisplayProperty($PropertyDescriptor)) + { + $self->{ErrMessage} = "Internal error?\n$self->{ErrMessage}"; + } + } + $self->GenerateErrorPopup(); + } + $self->GenerateActions(); + $self->GenerateFormEnd(); + $Text = $self->GetFooterText(); + if ($Text) + { + print "<p>$Text</p>\n"; + } + print "</div><!--Content-->\n"; + print "</div><!--ItemBody-->\n"; } -sub GetActions($) +sub GeneratePage($) { - #my ($self) = @_; - return []; + my ($self) = @_; + + if ($self->GetParam("Action")) + { + $self->{ActionPerformed} = $self->OnAction($self->GetParam("Action")); + } + + $self->SUPER::GeneratePage(); +} + + +# +# Validating and saving the form content +# + +sub Validate($) +{ + my ($self) = @_; + + foreach my $PropertyDescriptor (@{$self->GetPropertyDescriptors()}) + { + my $Value = $self->GetParam($PropertyDescriptor->GetName()); + my $ErrMessage = $PropertyDescriptor->ValidateValue($Value, 1); + if ($ErrMessage) + { + $self->{ErrMessage} = $ErrMessage; + $self->{ErrField} = $PropertyDescriptor->GetName(); + return !1; + } + } + + return 1; } sub SaveProperty($$$) @@ -394,31 +414,34 @@ sub Save($) return 1; } -sub OnAction($$) -{ - my ($self, $Action) = @_; - die "No action defined for $Action"; +# +# Actions handling +# + +sub GetActions($) +{ + #my ($self) = @_; + return []; } -sub Validate($) +sub GenerateActions($) { my ($self) = @_; - my $PropertyDescriptors = $self->GetPropertyDescriptors(); - foreach my $PropertyDescriptor (@{$PropertyDescriptors}) + print "<div class='ItemActions'>\n"; + foreach my $Action (@{$self->GetActions()}) { - my $Value = $self->GetParam($PropertyDescriptor->GetName()); - my $ErrMessage = $PropertyDescriptor->ValidateValue($Value, 1); - if ($ErrMessage) - { - $self->{ErrMessage} = $ErrMessage; - $self->{ErrField} = $PropertyDescriptor->GetName(); - return !1; - } + print "<input type='submit' name='Action' value='$Action'/>\n"; } + print "</div>\n"; +} - return 1; +sub OnAction($$) +{ + my ($self, $Action) = @_; + + die "No action defined for $Action"; } 1; diff --git a/testbot/lib/ObjectModel/CGI/ItemPage.pm b/testbot/lib/ObjectModel/CGI/ItemPage.pm index 09dfc0496..c0105f7d6 100644 --- a/testbot/lib/ObjectModel/CGI/ItemPage.pm +++ b/testbot/lib/ObjectModel/CGI/ItemPage.pm @@ -55,28 +55,10 @@ sub _initialize($$$$) } } -sub GenerateFormStart($) -{ - my ($self) = @_; - - $self->SUPER::GenerateFormStart(); - my ($MasterColNames, $MasterColValues) = $self->{Collection}->GetMasterCols(); - if (defined($MasterColNames)) - { - foreach my $ColIndex (0 .. @$MasterColNames) - { - print "<div><input type='hidden' name='", $MasterColNames->[$ColIndex], - "' value='", $self->escapeHTML($MasterColValues->[$ColIndex]), - "' /></div>\n"; - } - } - if (! $self->{Item}->GetIsNew()) - { - print "<div><input type='hidden' name='Key' value='", - $self->escapeHTML($self->{Item}->GetKey()), "' /></div>\n"; - } -} +# +# Property handling +# sub GetPropertyValue($$) { @@ -86,14 +68,6 @@ sub GetPropertyValue($$) return $self->{Item}->$PropertyName; } -sub GetTitle($) -{ - my ($self) = @_; - - return $self->GetParam("Key") ? $self->GetParam("Key") : - "Add " . $self->{Collection}->GetItemName(); -} - sub DisplayProperty($$) { my ($self, $PropertyDescriptor) = @_; @@ -111,40 +85,72 @@ sub DisplayProperty($$) $Display; } -sub GetActions($) + +# +# Form page generation +# + +sub GetTitle($) { my ($self) = @_; - my @Actions = @{$self->SUPER::GetActions()}; - push @Actions, "Save", "Cancel"; - - return \@Actions; + return $self->GetParam("Key") ? $self->GetParam("Key") : + "Add " . $self->{Collection}->GetItemName(); } -sub SaveProperty($$$) +sub GenerateFormStart($) { - my ($self, $PropertyDescriptor, $Value) = @_; + my ($self) = @_; - if ($PropertyDescriptor->GetClass() eq "Basic" && - $PropertyDescriptor->GetType() eq "B" && $Value) + $self->SUPER::GenerateFormStart(); + + my ($MasterColNames, $MasterColValues) = $self->{Collection}->GetMasterCols(); + if (defined($MasterColNames)) { - $Value = 1; + foreach my $ColIndex (0 .. @$MasterColNames) + { + print "<div><input type='hidden' name='", $MasterColNames->[$ColIndex], + "' value='", $self->escapeHTML($MasterColValues->[$ColIndex]), + "' /></div>\n"; + } + } + if (! $self->{Item}->GetIsNew()) + { + print "<div><input type='hidden' name='Key' value='", + $self->escapeHTML($self->{Item}->GetKey()), "' /></div>\n"; } +} - my $PropertyName = $PropertyDescriptor->GetName(); - $self->{Item}->$PropertyName($Value); - return 1; -} +# +# Actions handling +# -sub Save($) +sub GetActions($) { my ($self) = @_; - return !1 if (!$self->SUPER::Save()); + my @Actions = @{$self->SUPER::GetActions()}; + push @Actions, "Save", "Cancel"; - (my $_ErrKey, $self->{ErrField}, $self->{ErrMessage}) = $self->{Collection}->Save(); - return !defined $self->{ErrMessage}; + return \@Actions; +} + +sub RedirectToList($) +{ + my ($self) = @_; + + my $Target = $self->{Collection}->GetCollectionName() . "List.pl"; + my ($MasterColNames, $MasterColValues) = $self->{Collection}->GetMasterCols(); + if (defined($MasterColNames)) + { + foreach my $ColIndex (0 .. @$MasterColNames - 1) + { + $Target .= ($ColIndex == 0 ? "?" : "&") . $MasterColNames->[$ColIndex] . + "=" . url_escape($MasterColValues->[$ColIndex]); + } + } + return $self->Redirect($Target); } sub OnAction($$) @@ -164,21 +170,35 @@ sub OnAction($$) return $self->SUPER::OnAction($Action); } -sub RedirectToList($) + +# +# Validating and saving the form content +# + +sub SaveProperty($$$) { - my ($self) = @_; + my ($self, $PropertyDescriptor, $Value) = @_; - my $Target = $self->{Collection}->GetCollectionName() . "List.pl"; - my ($MasterColNames, $MasterColValues) = $self->{Collection}->GetMasterCols(); - if (defined($MasterColNames)) + if ($PropertyDescriptor->GetClass() eq "Basic" && + $PropertyDescriptor->GetType() eq "B" && $Value) { - foreach my $ColIndex (0 .. @$MasterColNames - 1) - { - $Target .= ($ColIndex == 0 ? "?" : "&") . $MasterColNames->[$ColIndex] . - "=" . url_escape($MasterColValues->[$ColIndex]); - } + $Value = 1; } - return $self->Redirect($Target); + + my $PropertyName = $PropertyDescriptor->GetName(); + $self->{Item}->$PropertyName($Value); + + return 1; +} + +sub Save($) +{ + my ($self) = @_; + + return !1 if (!$self->SUPER::Save()); + + (my $_ErrKey, $self->{ErrField}, $self->{ErrMessage}) = $self->{Collection}->Save(); + return !defined $self->{ErrMessage}; } 1; diff --git a/testbot/lib/ObjectModel/CGI/Page.pm b/testbot/lib/ObjectModel/CGI/Page.pm index b0450d0e7..1e8f55d31 100644 --- a/testbot/lib/ObjectModel/CGI/Page.pm +++ b/testbot/lib/ObjectModel/CGI/Page.pm @@ -55,6 +55,37 @@ sub _initialize($$$) #my ($self, $Request, $RequiredRole) = @_; } +sub SetPageBaseCreator($) +{ + ($PageBaseCreator) = @_; +} + +sub GetPageBase($) +{ + my ($self) = @_; + + return $self->{PageBase}; +} + +sub CGI($) +{ + my ($self) = @_; + + return $self->{CGIObj}; +} + +sub escapeHTML($$) +{ + my ($self, $String) = @_; + + return $self->{CGIObj}->escapeHTML($String); +} + + +# +# CGI parameters support +# + =pod =over 12 @@ -120,48 +151,84 @@ sub SetParam($$$) } } -sub CGI($) + +# +# Session support +# + +sub UnsetCookies($) { my ($self) = @_; - return $self->{CGIObj}; + $self->{PageBase}->UnsetCookies($self); } -sub escapeHTML($$) +sub SetCookies($) { - my ($self, $String) = @_; + my ($self) = @_; - return $self->{CGIObj}->escapeHTML($String); + $self->{PageBase}->SetCookies($self); } -sub GetPageBase($) +sub GetCurrentSession($) { my ($self) = @_; - return $self->{PageBase}; + return $self->{PageBase}->GetCurrentSession(); } -sub GenerateHttpHeaders($) +sub SetCurrentSession($$) +{ + my ($self, $Session) = @_; + + $self->{PageBase}->SetCurrentSession($self, $Session); +} + +sub Redirect($$) +{ + my ($self, $Location) = @_; + + return $self->{PageBase}->Redirect($self, $Location); +} + + +# +# Error handling framework +# + +sub GetErrField($) { my ($self) = @_; - $self->{PageBase}->GenerateHttpHeaders($self); + return $self->{ErrField}; } -sub UnsetCookies($) +sub GetErrMessage($) { my ($self) = @_; - $self->{PageBase}->UnsetCookies($self); + return $self->{ErrMessage}; } -sub SetCookies($) +sub GenerateErrorDiv($) { my ($self) = @_; - $self->{PageBase}->SetCookies($self); + $self->{PageBase}->GenerateErrorDiv($self); +} + +sub GenerateErrorPopup($) +{ + my ($self) = @_; + + $self->{PageBase}->GenerateErrorPopup($self); } + +# +# HTML page generation +# + =pod =over 12 @@ -197,39 +264,32 @@ sub GetTitle($) return undef; } -sub GenerateHeader($) -{ - my ($self) = @_; - - $self->{PageBase}->GenerateHeader($self); -} - -sub GenerateFooter($) +sub GenerateHttpHeaders($) { my ($self) = @_; - $self->{PageBase}->GenerateFooter($self); + $self->{PageBase}->GenerateHttpHeaders($self); } -sub GenerateErrorDiv($) +sub GenerateHeader($) { my ($self) = @_; - $self->{PageBase}->GenerateErrorDiv($self); + $self->{PageBase}->GenerateHeader($self); } -sub GenerateErrorPopup($) +sub GenerateBody($) { my ($self) = @_; - $self->{PageBase}->GenerateErrorPopup($self); + die "Pure virtual function " . ref($self) . "::GenerateBody called"; } -sub GenerateBody($) +sub GenerateFooter($) { my ($self) = @_; - die "Pure virtual function " . ref($self) . "::GenerateBody called"; + $self->{PageBase}->GenerateFooter($self); } sub GeneratePage($) @@ -242,44 +302,4 @@ sub GeneratePage($) $self->GenerateFooter(); } -sub Redirect($$) -{ - my ($self, $Location) = @_; - - return $self->{PageBase}->Redirect($self, $Location); -} - -sub GetCurrentSession($) -{ - my ($self) = @_; - - return $self->{PageBase}->GetCurrentSession(); -} - -sub SetCurrentSession($$) -{ - my ($self, $Session) = @_; - - $self->{PageBase}->SetCurrentSession($self, $Session); -} - -sub GetErrMessage($) -{ - my ($self) = @_; - - return $self->{ErrMessage}; -} - -sub GetErrField($) -{ - my ($self) = @_; - - return $self->{ErrField}; -} - -sub SetPageBaseCreator($) -{ - ($PageBaseCreator) = @_; -} - 1; diff --git a/testbot/lib/WineTestBot/CGI/PageBase.pm b/testbot/lib/WineTestBot/CGI/PageBase.pm index b7edd8fca..b36b28d9a 100644 --- a/testbot/lib/WineTestBot/CGI/PageBase.pm +++ b/testbot/lib/WineTestBot/CGI/PageBase.pm @@ -69,40 +69,16 @@ sub _initialize($$$$) #my ($self, $Page, $Request, $RequiredRole) = @_; } -sub CheckSecurePage($$) +sub CreatePageBase($$$@) { - my ($self, $Page) = @_; - - if ($UseSSL && ! SecureConnection()) - { - exit($self->Redirect($Page, MakeSecureURL($ENV{"REQUEST_URI"}))); - } + #my ($Page, $Request, $RequiredRole) = @_; + return WineTestBot::CGI::PageBase->new(@_); } -sub GenerateHttpHeaders($) -{ - my ($self) = @_; - - my $Request = $self->{Request}; - - # Date in the past - $Request->headers_out->add("Expires", "Sun, 25 Jul 1997 05:00:00 GMT"); - - # always modified - $Request->headers_out->add("Last-Modified", (scalar gmtime) . " GMT"); - - # HTTP/1.1 - $Request->headers_out->add("Cache-Control", "no-cache, must-revalidate, " . - "post-check=0, pre-check=0"); - - # HTTP/1.0 - $Request->headers_out->add("Pragma", "no-cache"); - # Force char set - $Request->content_type("text/html; charset=UTF-8"); - - $self->SetCookies(); -} +# +# Session support +# sub UnsetCookies($) { @@ -175,7 +151,7 @@ sub SetCookies($) $Expire = undef; } } - + $Cookie = CGI::Cookie->new(-Name => "SessionActive", -Value => $SessionPermanent, -Expires => $Expire, @@ -189,6 +165,139 @@ sub SetCookies($) } } +sub GetCurrentSession($) +{ + my ($self) = @_; + + if ($UseSSL && ! SecureConnection()) + { + return undef; + } + + if (! defined($self->{Session})) + { + my %Cookies = CGI::Cookie->fetch($self->{Request}); + if (defined($Cookies{"SessionId"})) + { + my $SessionId = $Cookies{"SessionId"}->value; + my $Sessions = CreateSessions(); + $self->{Session} = $Sessions->GetItem($SessionId); + } + } + + return $self->{Session}; +} + +sub SetCurrentSession($$$) +{ + my ($self, $Page, $Session) = @_; + + $self->{Session} = $Session; + if (! defined($Session)) + { + $self->UnsetCookies(); + } +} + +sub SessionActive($) +{ + my ($self) = @_; + + if (defined($self->GetCurrentSession())) + { + return 1; + } + + my %Cookies = CGI::Cookie->fetch($self->{Request}); + if ($UseSSL && ! SecureConnection() && defined($Cookies{"SessionActive"})) + { + return 1; + } + + return !1; +} + +sub Redirect($$$) +{ + my ($self, $Page, $Location) = @_; + + $self->SetCookies(); + if (substr($Location, 0, 4) ne "http") + { + # Use the same protocol as for the current page. To force switching to + # https the caller should use MakeSecureURL(). + my $Protocol = SecureConnection() ? "https://" : "http://"; + if (substr($Location, 0, 1) ne "/") + { + # Despite its name, Request->uri only contains the path portion of the + # URI, excluding the protocol, hostname and parameters! + my $URI = $self->{Request}->uri; + $URI =~ s=^(.*)/[^/]*$=$1/$Location=; + $Location = $URI; + } + $Location = $Protocol . $ENV{"HTTP_HOST"} . $Location; + } + $self->{Request}->headers_out->set("Location", $Location); + $self->{Request}->status(Apache2::Const::REDIRECT); + return 0; # a suitable exit code +} + +sub CheckSecurePage($$) +{ + my ($self, $Page) = @_; + + if ($UseSSL && ! SecureConnection()) + { + exit($self->Redirect($Page, MakeSecureURL($ENV{"REQUEST_URI"}))); + } +} + + +# +# Error handling framework +# + +sub GenerateErrorDiv($$) +{ + my ($self, $Page) = @_; + + my $ErrMessage = $Page->GetErrMessage(); + if ($ErrMessage) + { + print "<noscript>\n"; + print "<div id='errormessage'>", $Page->CGI->escapeHTML($ErrMessage), "</div>\n"; + print "</noscript>\n"; + } +} + +sub GenerateErrorPopup($$) +{ + my ($self, $Page) = @_; + + my $ErrMessage = $Page->GetErrMessage(); + if ($ErrMessage) + { + print "<script type='text/javascript'>\n"; + print "<!--\n"; + $ErrMessage =~ s~\\~\\\\~g; + $ErrMessage =~ s~"~\\\"~g; + $ErrMessage =~ s~\n~\\n~g; + print "function ShowError() { alert(\"$ErrMessage\"); }\n"; + my $ErrField = $Page->GetErrField(); + if ($ErrField) + { + print "document.forms[0].", $ErrField, ".focus();\n"; + } + print "//-->\n"; + print "</script>\n"; + } +} + + +# +# HTML page generation +# + sub GetPageTitle($$) { my ($self, $Page) = @_; @@ -199,6 +308,43 @@ sub GetPageTitle($$) return $Title; } +sub GenerateHttpHeaders($) +{ + my ($self) = @_; + + my $Request = $self->{Request}; + + # Date in the past + $Request->headers_out->add("Expires", "Sun, 25 Jul 1997 05:00:00 GMT"); + + # always modified + $Request->headers_out->add("Last-Modified", (scalar gmtime) . " GMT"); + + # HTTP/1.1 + $Request->headers_out->add("Cache-Control", "no-cache, must-revalidate, " . + "post-check=0, pre-check=0"); + + # HTTP/1.0 + $Request->headers_out->add("Pragma", "no-cache"); + + # Force char set + $Request->content_type("text/html; charset=UTF-8"); + + $self->SetCookies(); +} + +sub GetOnLoadJavascriptFunction($$) +{ + my ($self, $Page) = @_; + + if ($Page->GetErrMessage()) + { + return "ShowError()"; + } + + return undef; +} + sub GenerateHeader($$) { my ($self, $Page) = @_; @@ -213,7 +359,7 @@ sub GenerateHeader($$) <link rel='stylesheet' href='/${ProjectName}TestBot.css' type='text/css' media='screen'> </head> EOF - + print "<body"; my $OnLoadJavascriptFunction = $self->GetOnLoadJavascriptFunction($Page); if ($OnLoadJavascriptFunction) @@ -323,6 +469,13 @@ EOF EOF } +sub GenerateBody($) +{ + my ($self) = @_; + + die "Pure virtual function " . ref($self) . "::GenerateBody called"; +} + sub GenerateFooter($) { my ($self) = @_; @@ -338,142 +491,4 @@ sub GenerateFooter($) EOF } -sub GenerateErrorDiv($$) -{ - my ($self, $Page) = @_; - - my $ErrMessage = $Page->GetErrMessage(); - if ($ErrMessage) - { - print "<noscript>\n"; - print "<div id='errormessage'>", $Page->CGI->escapeHTML($ErrMessage), "</div>\n"; - print "</noscript>\n"; - } -} - -sub GenerateErrorPopup($$) -{ - my ($self, $Page) = @_; - - my $ErrMessage = $Page->GetErrMessage(); - if ($ErrMessage) - { - print "<script type='text/javascript'>\n"; - print "<!--\n"; - $ErrMessage =~ s~\\~\\\\~g; - $ErrMessage =~ s~"~\\\"~g; - $ErrMessage =~ s~\n~\\n~g; - print "function ShowError() { alert(\"$ErrMessage\"); }\n"; - my $ErrField = $Page->GetErrField(); - if ($ErrField) - { - print "document.forms[0].", $ErrField, ".focus();\n"; - } - print "//-->\n"; - print "</script>\n"; - } -} - -sub GenerateBody($) -{ - my ($self) = @_; - - die "Pure virtual function " . ref($self) . "::GenerateBody called"; -} - -sub GetOnLoadJavascriptFunction($$) -{ - my ($self, $Page) = @_; - - if ($Page->GetErrMessage()) - { - return "ShowError()"; - } - - return undef; -} - -sub Redirect($$$) -{ - my ($self, $Page, $Location) = @_; - - $self->SetCookies(); - if (substr($Location, 0, 4) ne "http") - { - # Use the same protocol as for the current page. To force switching to - # https the caller should use MakeSecureURL(). - my $Protocol = SecureConnection() ? "https://" : "http://"; - if (substr($Location, 0, 1) ne "/") - { - # Despite its name, Request->uri only contains the path portion of the - # URI, excluding the protocol, hostname and parameters! - my $URI = $self->{Request}->uri; - $URI =~ s=^(.*)/[^/]*$=$1/$Location=; - $Location = $URI; - } - $Location = $Protocol . $ENV{"HTTP_HOST"} . $Location; - } - $self->{Request}->headers_out->set("Location", $Location); - $self->{Request}->status(Apache2::Const::REDIRECT); - return 0; # a suitable exit code -} - -sub GetCurrentSession($) -{ - my ($self) = @_; - - if ($UseSSL && ! SecureConnection()) - { - return undef; - } - - if (! defined($self->{Session})) - { - my %Cookies = CGI::Cookie->fetch($self->{Request}); - if (defined($Cookies{"SessionId"})) - { - my $SessionId = $Cookies{"SessionId"}->value; - my $Sessions = CreateSessions(); - $self->{Session} = $Sessions->GetItem($SessionId); - } - } - - return $self->{Session}; -} - -sub SetCurrentSession($$$) -{ - my ($self, $Page, $Session) = @_; - - $self->{Session} = $Session; - if (! defined($Session)) - { - $self->UnsetCookies(); - } -} - -sub SessionActive($) -{ - my ($self) = @_; - - if (defined($self->GetCurrentSession())) - { - return 1; - } - - my %Cookies = CGI::Cookie->fetch($self->{Request}); - if ($UseSSL && ! SecureConnection() && defined($Cookies{"SessionActive"})) - { - return 1; - } - - return !1; -} - -sub CreatePageBase($$$@) -{ - #my ($Page, $Request, $RequiredRole) = @_; - return WineTestBot::CGI::PageBase->new(@_); -} - 1; -- 2.30.2
Signed-off-by: Francois Gouget <fgouget(a)codeweavers.com> --- Again no impact on the website since only the POD documentation changes. With this groundwork in place the framework improvements will then resume. --- .../lib/ObjectModel/CGI/CollectionBlock.pm | 87 +++++++++- .../ObjectModel/CGI/CollectionBlockForPage.pm | 4 + testbot/lib/ObjectModel/CGI/CollectionPage.pm | 8 + testbot/lib/ObjectModel/CGI/FormPage.pm | 158 +++++++++++++++++- testbot/lib/ObjectModel/CGI/ItemPage.pm | 4 +- testbot/lib/ObjectModel/CGI/Page.pm | 68 +++++++- testbot/lib/WineTestBot/CGI/PageBase.pm | 40 ++++- 7 files changed, 359 insertions(+), 10 deletions(-) diff --git a/testbot/lib/ObjectModel/CGI/CollectionBlock.pm b/testbot/lib/ObjectModel/CGI/CollectionBlock.pm index 13bbc4c3f..6f5c4d5fa 100644 --- a/testbot/lib/ObjectModel/CGI/CollectionBlock.pm +++ b/testbot/lib/ObjectModel/CGI/CollectionBlock.pm @@ -2,6 +2,7 @@ # Base class for list blocks # # Copyright 2009 Ge van Geldorp +# Copyright 2014, 2018, 2021-2022 Francois Gouget # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public @@ -23,6 +24,45 @@ use strict; ObjectModel::CGI::CollectionBlock - Base class for list blocks +Generates a table representing the items contained in the specified collection +and provides support for: +- Linking to a page providing a detailed view of a given item. +- Selecting individual items and performing an action on them. + See GetItemActions() and OnItemActions(). +- Performing a global action. See GetActions() and OnAction(). + +Note that a web page may contain multiple collection blocks. + +Also, because this is only one part of a web page, some methods, such as those +dealing with errors, are delegated to the EnclosingPage object which must +implement the ObjectModel::CGI::Page interface. + +Other methods are designed so they can be overriden by the enclosing page as +a way to allow it to modify how the collection block looks or behaves. These +methods can be identified by their CallXxx() trampoline. The override +mechanism works as follows: +- The CollectionBlock class and any subclass should never call overridable + methods directly. Instead they should call the corresponding CallXxx() + trampoline. +- The CollectionBlock class provides a default CallXxx() implementation which + simply calls the corresponding Xxx() method. This allows using the + CollectionBlock as is. +- Pages that want to customize the CollectionBlock behavior should use the + CollectionBlockForPage class instead. That class provides an alternative + implementation for each CallXxx(...) method that calls + $self->{EnclosingPage}->Xxx($CollectionBlock, ...). Note how the Xxx() + method in the enclosing page gets an extra parameter so it can both know + which collection block it received the call from, and call the collection + block methods. +- The page should in turn provide implementations for all the Xxx() methods. + The simplest way to do so is for such pages use CollectionPage as their base + class. CollectionPage provides default Xxx($CollectionBlock,...) + implementations that just reflect these calls back to + $CollectionBlock->Xxx(). + +Of course an alternative way for a page to customize the collection block +behavior is to subclass it and use that subclass instead. + =cut package ObjectModel::CGI::CollectionBlock; @@ -103,6 +143,19 @@ sub CallDisplayProperty($$) return $self->DisplayProperty($PropertyDescriptor); } +=pod +=over 12 + +=item C<DisplayProperty()> + +Specifies whether to hide the given property. + +Any value evaluating to false specifies that the property should be hidden and +all others that it should be shown. + +=back +=cut + sub DisplayProperty($$) { my ($self, $PropertyDescriptor) = @_; @@ -142,6 +195,7 @@ sub GetDisplayValue($$$) { if (defined($Value)) { + # Note: This only supports single-key Itemrefs foreach $PropertyDescriptor (@{$Value->GetPropertyDescriptors()}) { if ($PropertyDescriptor->GetIsKey()) @@ -517,9 +571,12 @@ sub CallGetItemActions($) Returns the list of per-item actions. -This is a set of actions that is applied to each selected item in the +This is a set of actions that can be applied to each selected item in the collection. +If the set is empty the GUI will provide no way to select items. Otherwise a +column of checkboxes is added. + =back =cut @@ -536,6 +593,19 @@ sub CallOnItemAction($$$) return $self->OnItemAction($Item, $Action); } +=pod +=over 12 + +=item C<OnItemAction()> + +This method is called to apply $Action to each selected item. + +Note that it is the responsibility of this method to validate the property +values by calling Validate() before performing the action. + +=back +=cut + sub OnItemAction($$$) { my ($self, $Item, $Action) = @_; @@ -588,6 +658,21 @@ sub GetActions($) return \@Actions; } +=pod +=over 12 + +=item C<OnAction()> + +Implements the "Add" and per-item actions. + +Note that it is the responsibility of this method to validate the property +values by calling Validate() before performing the action. + +=back +=cut + +# Note that there is no call to OnAction() in the CollectionBlock class so +# there is no need for a CallOnAction() trampoline. sub OnAction($$) { my ($self, $Action) = @_; diff --git a/testbot/lib/ObjectModel/CGI/CollectionBlockForPage.pm b/testbot/lib/ObjectModel/CGI/CollectionBlockForPage.pm index 94d5f8672..5bdc7d32e 100644 --- a/testbot/lib/ObjectModel/CGI/CollectionBlockForPage.pm +++ b/testbot/lib/ObjectModel/CGI/CollectionBlockForPage.pm @@ -2,6 +2,7 @@ # Collection block for list pages # # Copyright 2009 Ge van Geldorp +# Copyright 2014, 2017-2018, 2022 Francois Gouget # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public @@ -25,6 +26,9 @@ package ObjectModel::CGI::CollectionBlockForPage; ObjectModel::CGI::CollectionBlockForPage - Collection block for list pages +Allows the CollectionPage class to provide implementations for most of the +CollectionBlock methods. See CollectionBlock for details. + =cut use ObjectModel::CGI::CollectionBlock; diff --git a/testbot/lib/ObjectModel/CGI/CollectionPage.pm b/testbot/lib/ObjectModel/CGI/CollectionPage.pm index 993f18685..d59310be5 100644 --- a/testbot/lib/ObjectModel/CGI/CollectionPage.pm +++ b/testbot/lib/ObjectModel/CGI/CollectionPage.pm @@ -2,6 +2,7 @@ # Base class for list pages # # Copyright 2009 Ge van Geldorp +# Copyright 2014, 2017-2018, 2022 Francois Gouget # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public @@ -25,6 +26,13 @@ package ObjectModel::CGI::CollectionPage; ObjectModel::CGI::CollectionPage - Base class for list pages +Generates a page containing a single collection block. + +It uses the CollectionBlockForPage class which means CollectionPage implements +both the ObjectModel::CGI::Page and ObjectModel::CGI::CollectionBlock +interfaces. The latter allows it to customize the collection block without +having to define a CollectionBlock subclass. + =cut use ObjectModel::CGI::Page; diff --git a/testbot/lib/ObjectModel/CGI/FormPage.pm b/testbot/lib/ObjectModel/CGI/FormPage.pm index 588ea55b7..9e34a736d 100644 --- a/testbot/lib/ObjectModel/CGI/FormPage.pm +++ b/testbot/lib/ObjectModel/CGI/FormPage.pm @@ -2,7 +2,7 @@ # Base class for web pages containing a form # # Copyright 2009 Ge van Geldorp -# Copyright 2012 Francois Gouget +# Copyright 2012, 2014, 2017-2018, 2022 Francois Gouget # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public @@ -26,12 +26,55 @@ package ObjectModel::CGI::FormPage; ObjectModel::CGI::FormPage - Base class for web forms +This class generates a page that: +- Displays a list of properties, allows editing them, or a mix of both. +- Provides a list of actions that can be applied after visualizing or editing + the properties. +- Provides the framework for validating the property values and saving them. + +This page has the following properties: +=over + +=item Method +Specifies how to send the CGI parameters for the property values (get or post). + +=item HasRequired +True if the form has fields that are mandatory. + +=item ActionPerformed +True if an action was specified and performed. + +=back + +A typical use takes this form: + +my $PropertyDescriptors = [ ... ]; +my $MyFormPage = MyFormPage->new($Request, "required-privileges", $PropertyDescriptors); +$MyFormPage->GeneratePage(); + =cut use ObjectModel::CGI::Page; our @ISA = qw(ObjectModel::CGI::Page); +=pod +=over 12 + +=item C<_initialize()> + +This method is called by the constructor to initialize the form page. + +The PropertyDescriptors parameter specifies a reference to the list of +properties that the form should show or allow editing, as specified by +DisplayProperty(). It may be undefined if determining the property list is +delegated to GetPropertyDescriptors(). + +See also Page::new(). + +=back +=cut + sub _initialize($$$$) { my ($self, $Request, $RequiredRole, $PropertyDescriptors) = @_; @@ -49,6 +92,20 @@ sub _initialize($$$$) # Property handling # +=pod +=over 12 + +=item C<GetPropertyDescriptors()> + +Returns a reference to a list of ObjectModel::PropertyDescriptor objects +describing the fields to be displayed / edited. This also defines the set of +CGI parameters that the page supports. + +This must not return undef. + +=back +=cut + sub GetPropertyDescriptors($) { my ($self) = @_; @@ -72,6 +129,32 @@ sub GetPropertyDescriptorByName($$) return undef; } +=pod +=over 12 + +=item C<DisplayProperty()> + +Specifies whether to hide, display or allow editing the given property. + +Return values: +=over +=item "" +Any value evaluating to false specifies that the property should be hidden. + +=item "ro" +Specifies that the property is read-only, i.e. GenerateField() should display +it instead of generating an edit field. + +=item "rw" +Specifies that GenerateField() should allow editing the property. +Note that this implies that $PropertyDescriptor->GetName() should be a valid +HTTP parameter name. + +=back + +=back +=cut + sub DisplayProperty($$) { my ($self, $PropertyDescriptor) = @_; @@ -92,6 +175,20 @@ sub DisplayProperty($$) "ro"; } +=pod +=over 12 + +=item C<GetPropertyValue()> + +Returns the underlying property value. + +This is used to initialize the form with the properties of the 'object' to be +modified or displayed. The default implementation considers that there is no +underlying value. + +=back +=cut + sub GetPropertyValue($$) { #my ($self, $PropertyDescriptor) = @_; @@ -135,6 +232,17 @@ sub GetInputType($$) "text"; } +=pod +=over 12 + +=item C<GenerateRequired()> + +Generates an HTML snippet to be put next to an input field to indicate it must +be set. + +=back +=cut + sub GenerateRequired($$) { my ($self, $PropertyDescriptor) = @_; @@ -356,6 +464,26 @@ sub GeneratePage($) # Validating and saving the form content # +=pod +=over 12 + +=item C<Validate()> + +Validates the property values. + +Note that this method is not called in the default implementation. Subclasses +would likely want to call it in OnAction() or possibly in _initialize() after +having set up the property descriptors list. + +The default implementation only checks the individual property values using +the corresponding property descriptor's ValidateValue() method. + +Any cross-property consistency checks should be done by redefining this method +in subclasses. + +=back +=cut + sub Validate($) { my ($self) = @_; @@ -419,6 +547,20 @@ sub Save($) # Actions handling # +=pod +=over 12 + +=item C<GetActions()> + +Returns a list of actions that can be applied after completing or reading this +form. Each action is a string which is used as the label of a button at the +bottom of the form. + +By default there is no action. + +=back +=cut + sub GetActions($) { #my ($self) = @_; @@ -437,6 +579,20 @@ sub GenerateActions($) print "</div>\n"; } +=pod +=over 12 + +=item C<OnAction()> + +This method should be redefined in subclasses to implement the supported +actions. + +Note that it is the responsibility of this method to validate the property +values by calling Validate() before performing the action. + +=back +=cut + sub OnAction($$) { my ($self, $Action) = @_; diff --git a/testbot/lib/ObjectModel/CGI/ItemPage.pm b/testbot/lib/ObjectModel/CGI/ItemPage.pm index c0105f7d6..66fcab755 100644 --- a/testbot/lib/ObjectModel/CGI/ItemPage.pm +++ b/testbot/lib/ObjectModel/CGI/ItemPage.pm @@ -1,8 +1,8 @@ # -*- Mode: Perl; perl-indent-level: 2; indent-tabs-mode: nil -*- -# Base class for web pages containing a db bound form +# Base class for web pages containing a DB bound form # # Copyright 2009 Ge van Geldorp -# Copyright 2012 Francois Gouget +# Copyright 2012-2014, 2017-2018, 2022 Francois Gouget # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public diff --git a/testbot/lib/ObjectModel/CGI/Page.pm b/testbot/lib/ObjectModel/CGI/Page.pm index 1e8f55d31..d5988803c 100644 --- a/testbot/lib/ObjectModel/CGI/Page.pm +++ b/testbot/lib/ObjectModel/CGI/Page.pm @@ -2,6 +2,7 @@ # Base class for web pages # # Copyright 2009 Ge van Geldorp +# Copyright 2012, 2014, 2017-2018, 2022 Francois Gouget # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public @@ -25,6 +26,29 @@ package ObjectModel::CGI::Page; ObjectModel::CGI::Page - Base class for web pages +This class provide a generic framework for generating web pages: retrieving +the HTTP parameters, manipulating cookies, checking the session, handling +errors, generating the HTTP header, etc. + +It also defines their general structure: they shall be composed of a header, a +body and a footer. That structure can then be further refined by child classes +to suit their needs. + +What it does not do is define what the page should look like: what the banner +should contain, which CSS files to reference, how to navigate from one page to +another, etc. It also does not define how to check that the user is allowed to +access the page or how to display error messages. + +All these "look and feel" aspects are delegated to the PageBase object. Thus +many methods are just trampolines to their PageBase equivalent such that child +classes can call them and automatically get the appropriate behavior for the +actual website. + +A typical use takes this form: + +my $MyPage = MyPage->new($Request, "required-privileges"); +$MyPage->GeneratePage(); + =cut use Exporter 'import'; @@ -35,6 +59,29 @@ use CGI; my $PageBaseCreator; + +=pod +=over 12 + +=item C<new()> + +Creates a new page object. + +Parameters: +=over +=item Request +This is the HTTP request leading to this page. + +=item RequiredRole +This is a string specifying which users can access this page. + +=back + +Both parameters are passed to the PageBase constructor. + +=back +=cut + sub new($$$@) { my $class = shift; @@ -55,6 +102,19 @@ sub _initialize($$$) #my ($self, $Request, $RequiredRole) = @_; } +=pod +=over 12 + +=item C<SetPageBaseCreator()> + +Sets the function to be used to instantiate a new PageBase object for this +website. The resulting object can be accessed through GetPageBase(). + +See also ObjectModel::CGI::PageBase. + +=back +=cut + sub SetPageBaseCreator($) { ($PageBaseCreator) = @_; @@ -108,7 +168,7 @@ sub GetParamNames($) =head1 C<GetParam()> -Returns the specified parameter. +Returns the specified parameter value. Note that unlike CGI::param() this forces the result to scalar context to avoid security issues. @@ -153,7 +213,7 @@ sub SetParam($$$) # -# Session support +# Session management # sub UnsetCookies($) @@ -235,7 +295,7 @@ sub GenerateErrorPopup($) =head1 C<GetPageTitle()> This returns the page title as put in the HTML header. -Note that this may not be valid HTML and thus need escaping. +Note that this may not be valid HTML and thus may need escaping. =back =cut @@ -253,7 +313,7 @@ sub GetPageTitle($) =head1 C<GetTitle()> This returns the title for the current web page or email section. -Note that this may not be valid HTML and thus need escaping. +Note that this may not be valid HTML and thus my need escaping. =back =cut diff --git a/testbot/lib/WineTestBot/CGI/PageBase.pm b/testbot/lib/WineTestBot/CGI/PageBase.pm index b36b28d9a..6d94ae967 100644 --- a/testbot/lib/WineTestBot/CGI/PageBase.pm +++ b/testbot/lib/WineTestBot/CGI/PageBase.pm @@ -3,6 +3,7 @@ # # Copyright 2009 Ge van Geldorp # Copyright 2010 VMware, Inc. +# Copyright 2012-2014, 2017-2020, 2022 Francois Gouget # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public @@ -24,7 +25,13 @@ package WineTestBot::CGI::PageBase; =head1 NAME -WineTestBot::CGI::PageBase - Base class for web pages +WineTestBot::CGI::PageBase - Common boilerplate for the WineTestBot web pages + +This class defines the elements common to all the TestBot pages. + +This includes services such as how to check the user session and how to +display errors. And it also defines the general look and feel of the page by +providing a common banner, navigation menu and cascading style sheets. =cut @@ -39,6 +46,35 @@ use WineTestBot::CGI::Sessions; use WineTestBot::Config; use WineTestBot::Utils; + +=pod +=over 12 + +=item C<new()> + +Creates a PageBase object for the specified web page. + +Parameters: +=over +=Page +This is the page that lead to the creation of this PageBase object. + +=item Request +This is the HTTP request leading to this page. + +=item RequiredRole +This is a role that the user must have in order to be allowed to access this +page (see UserRoles). + +For instance an empty string specifies that any user can access the page, +even users with no account; while "admin" would specify that only logged-in +users with the "admin" role can access it. + +=back + +=back +=cut + sub new($$$$@) { my $class = shift; @@ -77,7 +113,7 @@ sub CreatePageBase($$$@) # -# Session support +# Session management # sub UnsetCookies($) -- 2.30.2
participants (1)
-
Francois Gouget