# Selima Website Content Management System # Group.pm: The account group form. # Copyright (c) 2004-2018 imacat. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # Author: imacat # First written: 2004-10-12 package Selima::Form::Group; use 5.008; use strict; use warnings; use base qw(Selima::Form); use Selima::CommText; use Selima::ChkPriv; use Selima::ChkFunc; use Selima::FormFunc; use Selima::HTTP; use Selima::MarkAbbr; use Selima::ShortCut; use Selima::UserName; use Selima::Unicode; # new: Initialize the HTML form table displayer sub new : method { local ($_, %_); my ($class, $status, $args, $self); ($class, $status, $args) = @_; $args = {} if !defined $args; # $args must be a hash reference http_500 "type of argument 2 must be a hash reference" if ref($args) ne "HASH"; $$args{"type"} = form_type if !exists $$args{"type"}; $$args{"table"} = "groups" if !exists $$args{"table"}; $$args{"deltext"} = C_("Delete this group") if !exists $$args{"deltext"}; if (!exists $$args{"summary"}) { # A form to create a new item if ($$args{"type"} eq "new") { $$args{"summary"} = C_("This table provides you a form to add a new group."); # A form to edit a current item } elsif ($$args{"type"} eq "cur") { $$args{"summary"} = C_("This table provides you a form to update a current group."); # A form to delete a current item } elsif ($$args{"type"} eq "del") { $$args{"summary"} = C_("This table provides you a form to delete a group."); } } if (!exists $$args{"cols"}) { # A form to create a new item if ($$args{"type"} eq "new") { $$args{"cols"} = [qw(id dsc subuser subgroup supgroup)]; # A form to edit a current item # A form to delete a current item } elsif ($$args{"type"} eq "cur" || $$args{"type"} eq "del") { $$args{"cols"} = [qw(sn id dsc subuser subgroup supgroup created createdby updated updatedby)]; } } if (!exists $$args{"title"}) { # A form to create a new item if ($$args{"type"} eq "new") { $$args{"title"} = C_("Add a New Group"); # A form to edit a current item } elsif ($$args{"type"} eq "cur") { $$args{"title"} = C_("Update a Current Group"); # A form to delete a current item } elsif ($$args{"type"} eq "del") { $$args{"title"} = C_("Delete a Group"); } } $self = $class->SUPER::new($status, $args); if ($$args{"type"} eq "cur" && !is_su && $self->{"sn"} == su_group_sn) { $self->{"nodelete"} = 1; push @{$self->{"prefmsg"}}, C_("This is a super-user group. You can only change parts of its infomation."); } return $self; } # _html_col_id: The group ID. sub _html_col_id : method { local ($_, %_); my $self; $self = $_[0]; # Read-only for a non-super-user editing a super-user if ($self->{"type"} eq "cur" && !is_su && $self->{"sn"} == su_group_sn) { $self->_html_coltmpl_ro("id", h_abbr(C_("Group ID.:"))); } else { $self->_html_coltmpl_text("id", h_abbr(C_("Group ID.:"))); } } # _html_col_dsc: The description sub _html_col_dsc : method { $_[0]->_html_coltmpl_text("dsc", h_abbr(C_("Description:"))); } # _html_col_subuser: Its child users sub _html_col_subuser : method { local ($_, %_); my ($self, $form, $current, $label, $orig, $new, $submit, $mark, $colspan, $title); #my ($col, $val, $colsn, $valsn, $title); $self = $_[0]; $form = $self->{"form"}; $current = $self->{"cur"}; $mark = $self->_mark("subuser"); $colspan = $self->_colspan; $submit = h_abbr(C_("Add a user")); # A form to create a new item if ($self->{"type"} eq "new") { $label = h_abbr(C_("[numerate,_1,User member]:", 0)); print << "EOT"; EOT print " "; for ($_ = 0, @_ = qw(); defined $form->param("subuser$_" . "sn"); $_++) { if (defined($title = user_opt_label(scalar $form->param("subuser$_" . "sn"), "subuser$_"))) { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("subuser$_" . "sn"), $self->_val_check("subuser$_"), $title); } else { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("subuser$_" . "sn"), $self->_val_check("subuser$_"), h_abbr(t_na)); } } push @_, "
  • \n"; print "\n "; print << "EOT"; EOT # A form to edit a current item } elsif ($self->{"type"} eq "cur") { # Read-only for a non-super-user editing a super-user group if (!is_su && $self->{"sn"} == su_group_sn) { $label = h_abbr(C_("[numerate,_1,User member]:", $_[0]->_delcolcount("subuser"))); print << "EOT"; $mark$label EOT print " "; for ($_ = 0, @_ = qw(); $_ < $current->param("subusercount"); $_++) { push @_, "
  • " . $self->_cval_text("subuser$_" . "title") . "
  • \n"; } print @_ > 0? "
      \n" . join("", @_) . "
    \n ": h_abbr(t_none); print << "EOT"; EOT } else { $label = h_abbr(C_("[numerate,_1,User member]:", 0)); $orig = h_abbr(C_("Original:")); $new = h_abbr(C_("New:")); print << "EOT"; $orig EOT print " "; for ($_ = 0, @_ = qw(); $_ < $current->param("subusercount"); $_++) { push @_, "
  • " . $self->_cval_text("subuser$_" . "title") . "
  • \n"; } print @_ > 0? "
      \n" . join("", @_) . "
    \n ": h_abbr(t_none); print << "EOT"; EOT print " "; for ($_ = 0, @_ = qw(); defined $form->param("subuser$_" . "sn"); $_++) { if (defined($title = user_opt_label(scalar $form->param("subuser$_" . "sn"), "subuser$_"))) { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("subuser$_" . "sn"), $self->_val_check("subuser$_"), $title); } else { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("subuser$_" . "sn"), $self->_val_check("subuser$_"), h_abbr(t_na)); } } push @_, "
  • \n"; print "
      \n" . join("", @_) . "
    \n "; print << "EOT"; EOT } # A form to delete a current item } else { $label = h_abbr(C_("[numerate,_1,User member]:", $_[0]->_delcolcount("subuser"))); print << "EOT"; $mark$label EOT print " "; for ($_ = 0, @_ = qw(); $_ < $current->param("subusercount"); $_++) { push @_, "
  • " . $self->_cval_text("subuser$_" . "title") . "
  • \n"; } print @_ > 0? "
      \n" . join("", @_) . "
    \n ": h_abbr(t_none); print << "EOT"; EOT } return; } # _html_col_subgroup: Its child groups sub _html_col_subgroup : method { local ($_, %_); my ($self, $form, $current, $label, $orig, $new, $submit, $mark, $colspan, $title); #my ($col, $val, $colsn, $valsn, $title); $self = $_[0]; $form = $self->{"form"}; $current = $self->{"cur"}; $mark = $self->_mark("subgroup"); $colspan = $self->_colspan; $submit = h_abbr(C_("Add a group")); # A form to create a new item if ($self->{"type"} eq "new") { $label = h_abbr(C_("[numerate,_1,Group member]:", 0)); print << "EOT"; EOT print " "; for ($_ = 0, @_ = qw(); defined $form->param("subgroup$_" . "sn"); $_++) { if (defined($title = group_opt_label(scalar $form->param("subgroup$_" . "sn"), "subgroup$_"))) { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("subgroup$_" . "sn"), $self->_val_check("subgroup$_"), $title); } else { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("subgroup$_" . "sn"), $self->_val_check("subgroup$_"), h_abbr(t_na)); } } push @_, "
  • \n"; print "
      \n" . join("", @_) . "
    \n "; print << "EOT"; EOT # A form to edit a current item } elsif ($self->{"type"} eq "cur") { # Read-only for a non-super-user editing a super-user group if (!is_su && $self->{"sn"} == su_group_sn) { $label = h_abbr(C_("[numerate,_1,Group member]:", $_[0]->_delcolcount("subgroup"))); print << "EOT"; $mark$label EOT print " "; for ($_ = 0, @_ = qw(); $_ < $current->param("subgroupcount"); $_++) { push @_, "
  • " . $self->_cval_text("subgroup$_" . "title") . "
  • \n"; } print @_ > 0? "
      \n" . join("", @_) . "
    \n ": h_abbr(t_none); print << "EOT"; EOT } else { $label = h_abbr(C_("[numerate,_1,Group member]:", 0)); $orig = h_abbr(C_("Original:")); $new = h_abbr(C_("New:")); print << "EOT"; $orig EOT print " "; for ($_ = 0, @_ = qw(); $_ < $current->param("subgroupcount"); $_++) { push @_, "
  • " . $self->_cval_text("subgroup$_" . "title") . "
  • \n"; } print @_ > 0? "
      \n" . join("", @_) . "
    \n ": h_abbr(t_none); print << "EOT"; EOT print " "; for ($_ = 0, @_ = qw(); defined $form->param("subgroup$_" . "sn"); $_++) { if (defined($title = group_opt_label(scalar $form->param("subgroup$_" . "sn"), "subgroup$_"))) { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("subgroup$_" . "sn"), $self->_val_check("subgroup$_"), $title); } else { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("subgroup$_" . "sn"), $self->_val_check("subgroup$_"), h_abbr(t_na)); } } push @_, "
  • \n"; print "
      \n" . join("", @_) . "
    \n "; print << "EOT"; EOT } # A form to delete a current item } else { $label = h_abbr(C_("[numerate,_1,Group member]:", $_[0]->_delcolcount("subgroup"))); print << "EOT"; $mark$label EOT print " "; for ($_ = 0, @_ = qw(); $_ < $current->param("subgroupcount"); $_++) { push @_, "
  • " . $self->_cval_text("subgroup$_" . "title") . "
  • \n"; } print @_ > 0? "
      \n" . join("", @_) . "
    \n ": h_abbr(t_none); print << "EOT"; EOT } return; } # _html_col_supgroup: Its belonging groups sub _html_col_supgroup : method { local ($_, %_); my ($self, $form, $current, $label, $orig, $new, $submit, $mark, $colspan, $title); #my ($col, $val, $colsn, $valsn, $title); $self = $_[0]; $form = $self->{"form"}; $current = $self->{"cur"}; $mark = $self->_mark("supgroup"); $colspan = $self->_colspan; $label = h_abbr(C_("Belonging to:")); $submit = h_abbr(C_("Add a group")); # A form to create a new item if ($self->{"type"} eq "new") { print << "EOT"; EOT print " "; for ($_ = 0, @_ = qw(); defined $form->param("supgroup$_" . "sn"); $_++) { if (defined($title = group_opt_label(scalar $form->param("supgroup$_" . "sn"), "supgroup$_"))) { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("supgroup$_" . "sn"), $self->_val_check("supgroup$_"), $title); } else { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("supgroup$_" . "sn"), $self->_val_check("supgroup$_"), h_abbr(t_na)); } } push @_, "
  • \n"; print "
      \n" . join("", @_) . "
    \n "; print << "EOT"; EOT # A form to edit a current item } elsif ($self->{"type"} eq "cur") { # Read-only for a non-super-user editing a super-user group if (!is_su && $self->{"sn"} == su_group_sn) { print << "EOT"; $mark$label EOT print " "; for ($_ = 0, @_ = qw(); $_ < $current->param("supgroupcount"); $_++) { push @_, "
  • " . $self->_cval_text("supgroup$_" . "title") . "
  • \n"; } print @_ > 0? "
      \n" . join("", @_) . "
    \n ": h_abbr(t_none); print << "EOT"; EOT } else { $orig = h_abbr(C_("Original:")); $new = h_abbr(C_("New:")); print << "EOT"; $orig EOT print " "; for ($_ = 0, @_ = qw(); $_ < $current->param("supgroupcount"); $_++) { push @_, "
  • " . $self->_cval_text("supgroup$_" . "title") . "
  • \n"; } print @_ > 0? "
      \n" . join("", @_) . "
    \n ": h_abbr(t_none); print << "EOT"; EOT print " "; for ($_ = 0, @_ = qw(); defined $form->param("supgroup$_" . "sn"); $_++) { if (defined($title = group_opt_label(scalar $form->param("supgroup$_" . "sn"), "supgroup$_"))) { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("supgroup$_" . "sn"), $self->_val_check("supgroup$_"), $title); } else { push @_, sprintf("
  • \n" . " \n" . " %4\$s\n" . "
  • \n", h($_), $self->_val_text("supgroup$_" . "sn"), $self->_val_check("supgroup$_"), h_abbr(t_na)); } } push @_, "
  • \n"; print "
      \n" . join("", @_) . "
    \n "; print << "EOT"; EOT } # A form to delete a current item } else { print << "EOT"; $mark$label EOT print " "; for ($_ = 0, @_ = qw(); $_ < $current->param("supgroupcount"); $_++) { push @_, "
  • " . $self->_cval_text("supgroup$_" . "title") . "
  • \n"; } print @_ > 0? "
      \n" . join("", @_) . "
    \n ": h_abbr(t_none); print << "EOT"; EOT } return; } return 1;