[tools 1/2] testbot/cgi: Group related CGI framework methods together.
Francois Gouget
fgouget at codeweavers.com
Thu Mar 24 10:37:41 CDT 2022
Signed-off-by: Francois Gouget <fgouget at 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
More information about the wine-devel
mailing list