* AJAX: add handler 'question'

* REPORT: Don't fail if'nt HTTPD loaded
* HTTPD: remove unused ->{cgi} from 'question'

5 files changed, 122 insertions, 13 deletions

diff --git a/lib/XXV/MODULES/AUTOTIMER.pm b/lib/XXV/MODULES/AUTOTIMER.pm
index db2c02e..ec20e90 100644
--- a/lib/XXV/MODULES/AUTOTIMER.pm
+++ b/lib/XXV/MODULES/AUTOTIMER.pm
@@ -707,11 +707,11 @@ You can also fine tune your search :
             def   => sub {
                             my $value = $epg->{InFields} || ['title','subtitle'];
                             my @vals = (ref $value eq 'ARRAY') ? @$value : split(/\s*,\s*/, $value);
-                            my @ret;
+                            my $ret;
                             foreach my $v (@vals) {
-                                push(@ret,$in{$v});
+                                push(@$ret,$in{$v});
                             }
-                            return @ret;
+                            return $ret;
                           },
             check   => sub{
                 my $value = shift || return;
@@ -757,11 +757,11 @@ You can also fine tune your search :
             def   => sub {
                             my $value = $epg->{Done};
                             my @vals = (ref $value eq 'ARRAY') ? @$value : split(/\s*,\s*/, $value);
-                            my @ret;
+                            my $ret;
                             foreach my $v (@vals) {
-                                push(@ret,$do{$v});
+                                push(@$ret,$do{$v});
                             }
-                            return @ret;
+                            return $ret;
                           },
             check   => sub{
                 my $value = shift || '';
@@ -834,11 +834,11 @@ You can also fine tune your search :
             def   => sub {
                             my $value = $epg->{Weekdays} || ['Mon','Tue','Wed','Thu','Fri','Sat','Sun'];
                             my @vals = (ref $value eq 'ARRAY') ? @$value : split(/\s*,\s*/, $value);
-                            my @ret;
+                            my $ret;
                             foreach my $v (@vals) {
-                                push(@ret,$wd{$v});
+                                push(@$ret,$wd{$v});
                             }
-                            return @ret;
+                            return $ret;
                           },
             check   => sub{
                 my $value = shift || [$wd{'Mon'}, $wd{'Tue'}, $wd{'Wed'}, $wd{'Thu'}, $wd{'Fri'}, $wd{'Sat'}, $wd{'Sun'}];
diff --git a/lib/XXV/MODULES/RECORDS.pm b/lib/XXV/MODULES/RECORDS.pm
index 829dc21..d5f37ac 100644
--- a/lib/XXV/MODULES/RECORDS.pm
+++ b/lib/XXV/MODULES/RECORDS.pm
@@ -1764,7 +1764,7 @@ sub delete {
     my $record  = shift || return con_err($console,gettext("No recording defined for deletion! Please use rdelete 'id'."));
     my $answer  = shift || 0;
 
-    my @rcs  = split(/_/, $record);
+    my @rcs  = split(/[^0-9a-fl\:]/, $record);
     my $todelete;
     my $md5delete;
     my %rec;
diff --git a/lib/XXV/MODULES/REPORT.pm b/lib/XXV/MODULES/REPORT.pm
index 39fd46b..bba0b06 100644
--- a/lib/XXV/MODULES/REPORT.pm
+++ b/lib/XXV/MODULES/REPORT.pm
@@ -214,7 +214,9 @@ sub news {
     my $lev   = $obj->scala($levname)
         || return error('Problem to analyze level!');
 
-    my  $url = sprintf("http://%s:%s/", $obj->{host}, main::getModule('HTTPD')->{Port});
+    my $hmod = main::getModule('HTTPD') or return;
+
+    my  $url = sprintf("http://%s:%s/", $obj->{host}, $hmod->{Port});
         $url = sprintf("%s?cmd=%s&data=%s", $url, $cmd, $id)
             if($cmd && $id);
 
diff --git a/lib/XXV/OUTPUT/Ajax.pm b/lib/XXV/OUTPUT/Ajax.pm
index 9cd44b4..ca7dca9 100644
--- a/lib/XXV/OUTPUT/Ajax.pm
+++ b/lib/XXV/OUTPUT/Ajax.pm
@@ -121,6 +121,7 @@ sub out {
 	    $self->{output}->{data} = $data;
 	    $self->{output}->{param} = $para
 	        if($para);
+#dumper($self->{output});
 		} else {
 	    $self->{output}->{DATA} = $data;
 	    $self->{output}->{$name}->{data} = $data;
@@ -205,6 +206,114 @@ sub headerNoAuth {
 }
 
 # ------------------
+sub question {
+# ------------------
+    my $self         = shift || return error('No object defined!');
+    my $titel       = shift || 'undef';
+    my $questions   = shift || return error ('No data defined!');
+    my $erg         = shift || 0;
+
+    my $quest;
+
+    # Check Data
+    if(ref $erg eq 'HASH' and ref $questions eq 'ARRAY' and exists $erg->{action}) {
+        my $error;
+        @$quest = @$questions;
+        while (my ($name, $data) = splice(@$quest, 0, 2)) {
+
+            $data->{typ} = 'string'
+              unless($data->{typ});
+
+            # Required value ...
+            $error = $data->{req}
+                if($data->{req} and not $erg->{$name});
+
+            # Check Callback
+            if(exists $data->{check} and ref $data->{check} eq 'CODE' and not $error) {
+                ($erg->{$name}, $error) = $data->{check}($erg->{$name}, $data, $erg);
+            }
+
+            # Check on directory
+            if($data->{typ} eq 'dir' and $data->{required} and not -d $erg->{$name}) {
+                ($erg->{$name}, $error) = (undef, sprintf(gettext("Directory '%s' does not exist!"), $erg->{$name}));
+            }
+
+            # Check on file
+            if($data->{typ} eq 'file' and $data->{required} and not -e $erg->{$name}) {
+                ($erg->{$name}, $error) = (undef, sprintf(gettext("File '%s' does not exist!"), $erg->{$name}));
+            }
+
+            # Check on password (is not set the take the old password)
+            if($data->{typ} eq 'password' and not $erg->{$name}) {
+                $erg->{$name} = $data->{def};
+            }
+
+            if($error) {
+                $self->err(sprintf(gettext("Error '%s' (%s) : %s!"), $data->{msg}, $name, $error));
+                return undef;
+            }
+        }
+        unless($error) {
+            delete $erg->{action};
+            return $erg;
+        }
+    }
+
+  my $out = [];
+  if(ref $questions eq 'ARRAY') {
+    @$quest = @$questions;
+    while (my ($name, $data) = splice(@$quest, 0, 2)) {
+      my $type = $data->{typ} || 'string';
+      my $def ;
+      if(ref $data->{def} eq 'CODE') {
+        $def = $data->{def}();
+      } elsif(ref $data->{def} eq 'ARRAY') {
+        $def = join(',',@{$data->{def}});
+      } else {
+        $def = $data->{def};
+      } 
+      my $choices ;
+      if($data->{choices}) {
+        if(ref $data->{choices} eq 'CODE') {
+          $choices = $data->{choices}();
+        } else {
+          $choices = $data->{choices};
+        }
+        if(ref $choices eq 'ARRAY') {
+          #$choices = join(',',@$choices);
+        } 
+      }
+
+      push(@$out,[$name,$data->{msg},$type,$def,$data->{req} ? 1 : 0,$data->{readonly} ? 1 : 0,$choices]);
+    }
+    $self->out( $out, 0 , 'question' );
+  } else {
+    my $type = $questions->{typ} || 'string';
+    my $def ;
+    if(ref $questions->{def} eq 'CODE') {
+      $def = $questions->{def}();
+    } elsif(ref $questions->{def} eq 'ARRAY') {
+      $def = join(',',@{$questions->{def}});
+    } else {
+      $def = $questions->{def};
+    } 
+
+    my $choices ;
+    if($questions->{choices}) {
+        if(ref $questions->{choices} eq 'CODE') {
+          $choices = $questions->{choices}();
+        } else {
+          $choices = $questions->{choices};
+        }
+    }
+
+    push(@$out,[$type,$questions->{msg},$type,$def,$questions->{req} ? 1 : 0,$questions->{readonly} ? 1 : 0,$choices]);
+    $self->out( $out, 0 , 'question' );
+  }
+  return undef;
+}
+
+# ------------------
 sub msg {
 # ------------------
     my $self = shift || return error('No object defined!');
diff --git a/lib/XXV/OUTPUT/Html.pm b/lib/XXV/OUTPUT/Html.pm
index 2c67976..e28b87c 100644
--- a/lib/XXV/OUTPUT/Html.pm
+++ b/lib/XXV/OUTPUT/Html.pm
@@ -474,7 +474,6 @@ sub question {
     my $questions   = shift || return error ('No data defined!');
     my $erg         = shift || 0;
 
-    my $q = $self->{cgi};
     my $quest;
 
     # Check Data
@@ -523,7 +522,6 @@ sub question {
 
     $self->formStart($titel);
     if(ref $questions eq 'ARRAY') {
-        my $q = $self->{cgi};
         @$quest = @$questions;
         my $c=0;
         while (my ($name, $data) = splice(@$quest, 0, 2)) {