Initial commit.

lib/perl5/Selima/Processor/ListPref.pm

@@ -0,0 +1,157 @@
+# 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 <imacat@mail.imacat.idv.tw>
+# 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;