# Selima Website Content Management System # ListPref.pm: The list preference data processor. # Copyright (c) 2006-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: 2006-03-22 package Selima::Processor::ListPref; use 5.008; use strict; use warnings; use base qw(Selima::Processor); use CGI; use Selima::DataVars qw($DBH :dataman :input); use Selima::Guest; use Selima::LogIn; use Selima::UserPref; # Load these classes use Selima::Processor::UserPref; # new: Initialize the processor sub new : method { local ($_, %_); my ($self, $class); ($class, @_) = @_; $self = $class->SUPER::new(@_); $self->{"is_sql"} = 0 if is_guest; $self->{"names"} = [qw(listsize listcols)]; return $self; } # process: Process the form, fully sub process : method { local ($_, %_); my ($self, $form); ($self, @_) = @_; # Use the parent processor for ordinary users return $self->SUPER::process(@_) unless is_guest; # Guest preferences are saved in $SESSION $form = $self->{"form"}; $$SESSION{"userpref"} = {} if !exists $$SESSION{"userpref"}; ${$$SESSION{"userpref"}}{$form->param("domain")} = {} if !exists ${$$SESSION{"userpref"}}{$form->param("domain")}; $_ = ${$$SESSION{"userpref"}}{$form->param("domain")}; foreach my $name (@{$self->{"names"}}) { $$_{$name} = $form->param($name); } return; } # _save_cols: Save the column deposit sub _save_cols : method { local ($_, %_); my ($self, $form); $self = $_[0]; $form = $self->{"form"}; foreach my $name (@{$self->{"names"}}) { my ($val, $sql, $sth, $row, $sn, $cols, $subform); # Obtain the preference value $val = $self->_prefval($name); # Only update if value is different $_ = userpref $name, $form->param("domain"); next if defined $_ && $_ eq $val; # Check if there is already an existing user preference $sql = "SELECT * FROM userpref" . " WHERE usr=" . get_login_sn . " AND domain=" . $DBH->quote($form->param("domain")) . " AND name=" . $DBH->quote($name) . ";\n"; $sth = $DBH->prepare($sql); $sth->execute; # There is an existing user preference if ($sth->rows == 1) { my ($subform, $cols, %CURRENT_SUP); $row = $sth->fetchrow_hashref; %CURRENT_SUP = %CURRENT; %CURRENT = ( "sn" => $$row{"sn"}, "usr" => $$row{"usr"}, "domain" => $$row{"domain"}, "name" => $$row{"name"}, "value" => $$row{"value"}, ); $subform = new CGI(""); $subform->param("form", "cur"); $subform->param("sn", $$row{"sn"}); $subform->param("usr", get_login_sn); $subform->param("domain", $form->param("domain")); $subform->param("name", $name); $subform->param("value", $val); $cols = new Selima::Processor::UserPref($subform); $cols->_save_cols; push @{$self->{"subs"}}, $cols; %CURRENT = %CURRENT_SUP; # There is no existing user preference } else { my ($subform, $cols); $subform = new CGI(""); $subform->param("form", "new"); $subform->param("usr", get_login_sn); $subform->param("domain", $form->param("domain")); $subform->param("name", $name); $subform->param("value", $val); $cols = new Selima::Processor::UserPref($subform); $cols->_save_cols; push @{$self->{"subs"}}, $cols; } } return; } # _actlog: Log the activity sub _actlog : method { local ($_, %_); my $self; $self = $_[0]; # Run the sub-processors foreach (@{$self->{"subs"}}) { $_->_actlog if $_->_modified; } } # _prefval: Obtain the preference value sub _prefval : method { local ($_, %_); my ($self, $name); ($self, $name) = @_; # Specified return $_ if defined($_ = $self->{"form"}->param($name)); # No need to check the validility. Invalids are simply ignored. @_ = grep s/^${name}_//, $self->{"form"}->param; # Compose the preference value return join " ", @_; } return 1;