ori229/1.conf

## 1.conf
01_q:
בכל השאלות אחד פירושו בכלל לא, וחמש פירושו ממש כן.  ניתן לדלג על שאלות כאשר לא מעוניינים לענות או כאשר לא יודעים. שאלה ראשונה: מרגיש טוב היום?
02_q:
מאושר בחיים?
03_q:
אין כמו ארץ ישראל
04_q:
מטרה מרכזית לעבודה - כסף
05_q:
אם היה אפשר לקבל את המשכורת בלי לעבוד עדיין הייתי בא לעבודה
06_q:
נשים וגברים טובים בדברים שונים
07_q:
מי שעושה טוב מקבל תמורה איכשהו
08_q:
יש באמת בחירה חופשית?
09_q:
האדם התפתח מהקוף
10_q:
האדם נמצא בדרגה נעלה מהחיות
11_q:
האל דיבר עם משה
12_q:
האל דיבר עם ישו
13_q:
האל דיבר עם מוחמד
14_q:
יש משהו לאחר המוות
15_q:
יש באמת טלפטיה?
16_q:
עב"מים?
17_q:
פיות?
18_q:
בעד עונש מוות למחבלים?
19_q:
בעוד 100 שנה אף אחד לא ילך ברגל
20_q:
בעוד 100 שנה אף אחד לא יקרא ספר

## seker.pl
#!/path/to/perl
# https://.../seker.pl?game=1
use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use Encode; #use utf8;
use Time::HiRes;
$| = 1; # unbuffered output
my $q=new CGI;
print $q->header(-charset=>'utf-8');
print '
<!DOCTYPE html>
<html>
<head>
  <title>Survey</title><style>body{direction:rtl; font-size:180%;}input{font-size:150%;}</style><meta charset="UTF-8"><meta name="viewport" content="width=device-width, initial-scale=1.0">
</head>

<body>';
my $path = '/exlibris/aleph/a22_1/aleph/cgi/seker/';
my $game = $q->param('game');

my $conf_file = $path.'data/'.$game.'.conf';
my $results_file = $path.'data/game_'.$game.'.results';
my $conf_text = slurp($conf_file);
my %conf;
while ($conf_text=~m/(.*?):\n(.*?)\n/gs) {
  #print $1,'=',$2,"\n";
  $conf{$1} = $2;
}

my %q_and_a_to_choosers;
if ($q->param('results')) {
  my $results = slurp($results_file);
  #print " ooo $results";
  while ($results=~m/(.*?) for question (.*?) selected (.*?)\n/gs) {
    my $first_name = $1;
    my $question_code = $2;
    my $answer = $3;
    next if $question_code !~ /\d\d_q/;
    #print "ooo".$first_name,' for q ',$question_code,$conf{$question_code}," selected ",$answer,"\n";
    if ($q_and_a_to_choosers{$question_code.'='.$answer}) {
      $q_and_a_to_choosers{$question_code.'='.$answer} .= ', '. $first_name;
    } else {
      $q_and_a_to_choosers{$question_code.'='.$answer} = $first_name;
    }
  }

  print "<table border=1>";
  foreach my $key (sort keys %conf) {
    print "<tr><td colspan=5>".substr($key,0,2). ".  " . $conf{$key}."</td></tr>\n";

    print "<tr>";
    foreach my $num (1..5) {
      print "<td>$num</td>";
    }
    print "</tr>";

    print "<tr>";
    foreach my $num (1..5) {
      print "<td>";
      if ( $q_and_a_to_choosers{$key.'='.$num} ) {
        print $q_and_a_to_choosers{$key.'='.$num}."\n";
      } else {
        print " \n";
      }
      print "</td>";
    }
    print "</tr>";
    print "<tr><td colspan=5> </td></tr>\n";
    print "<tr><td colspan=5> </td></tr>\n";
    print "<tr><td colspan=5> </td></tr>\n";
    print "<tr><td colspan=5> </td></tr>\n";
    print "<tr><td colspan=5> </td></tr>\n";
    print "<tr><td colspan=5> </td></tr>\n";
  }
  print "</table>";

  exit;
}

if ($q->param('submit')) {
  open( OUT_F, ">>$results_file") or die "Cannot open $results_file as output\n" ;
  my @names = $q->param; my $c = 0;
  foreach my $name (sort @names) { $c++; print OUT_F  $q->param('first_name') . " for question $name selected ", $q->param($name),"\n"; }
  print "Thanks " . $q->param('first_name') ;
  exit;
}

print '<br><br>';
print '<form>';
print '<input type="hidden" name="game" value="'.$game.'">';
print '<input type="hidden" name="submit" value="true">';
print 'Your first name in Hebrew: <input type="text"   name="first_name" value=""><br/>';
foreach my $key (sort keys %conf) {
  #print "$key = $conf{$key}<br>\n";
  print $conf{$key}.'<br>'."\n";
  foreach my $num (1..5) {
    print '<input type="radio" name="'.$key.'" value="'.$num.'">'.$num.'<br>'."\n";
  }
}
print '<input type="submit" value="Submit">';
print '</form>';
exit;
###############################################################################
sub slurp {
    my $file = shift;
    open my $fh, '<', $file or die "can not find $file";
    local $/ = undef;
    my $cont = <$fh>;
    close $fh;
    return $cont;
}
	01_q:
	בכל השאלות אחד פירושו בכלל לא, וחמש פירושו ממש כן. ניתן לדלג על שאלות כאשר לא מעוניינים לענות או כאשר לא יודעים. שאלה ראשונה: מרגיש טוב היום?
	02_q:
	מאושר בחיים?
	03_q:
	אין כמו ארץ ישראל
	04_q:
	מטרה מרכזית לעבודה - כסף
	05_q:
	אם היה אפשר לקבל את המשכורת בלי לעבוד עדיין הייתי בא לעבודה
	06_q:
	נשים וגברים טובים בדברים שונים
	07_q:
	מי שעושה טוב מקבל תמורה איכשהו
	08_q:
	יש באמת בחירה חופשית?
	09_q:
	האדם התפתח מהקוף
	10_q:
	האדם נמצא בדרגה נעלה מהחיות
	11_q:
	האל דיבר עם משה
	12_q:
	האל דיבר עם ישו
	13_q:
	האל דיבר עם מוחמד
	14_q:
	יש משהו לאחר המוות
	15_q:
	יש באמת טלפטיה?
	16_q:
	עב"מים?
	17_q:
	פיות?
	18_q:
	בעד עונש מוות למחבלים?
	19_q:
	בעוד 100 שנה אף אחד לא ילך ברגל
	20_q:
	בעוד 100 שנה אף אחד לא יקרא ספר
	#!/path/to/perl
	# https://.../seker.pl?game=1
	use strict;
	use CGI;
	use CGI::Carp qw(fatalsToBrowser);
	use Encode; #use utf8;
	use Time::HiRes;
	$\| = 1; # unbuffered output
	my $q=new CGI;
	print $q->header(-charset=>'utf-8');
	print '
	<!DOCTYPE html>
	<html>
	<head>
	<title>Survey</title><style>body{direction:rtl; font-size:180%;}input{font-size:150%;}</style><meta charset="UTF-8"><meta name="viewport" content="width=device-width, initial-scale=1.0">
	</head>

	<body>';
	my $path = '/exlibris/aleph/a22_1/aleph/cgi/seker/';
	my $game = $q->param('game');

	my $conf_file = $path.'data/'.$game.'.conf';
	my $results_file = $path.'data/game_'.$game.'.results';
	my $conf_text = slurp($conf_file);
	my %conf;
	while ($conf_text=~m/(.?):\n(.?)\n/gs) {
	#print $1,'=',$2,"\n";
	$conf{$1} = $2;
	}

	my %q_and_a_to_choosers;
	if ($q->param('results')) {
	my $results = slurp($results_file);
	#print " ooo $results";
	while ($results=~m/(.?) for question (.?) selected (.*?)\n/gs) {
	my $first_name = $1;
	my $question_code = $2;
	my $answer = $3;
	next if $question_code !~ /\d\d_q/;
	#print "ooo".$first_name,' for q ',$question_code,$conf{$question_code}," selected ",$answer,"\n";
	if ($q_and_a_to_choosers{$question_code.'='.$answer}) {
	$q_and_a_to_choosers{$question_code.'='.$answer} .= ', '. $first_name;
	} else {
	$q_and_a_to_choosers{$question_code.'='.$answer} = $first_name;
	}
	}

	print "<table border=1>";
	foreach my $key (sort keys %conf) {
	print "<tr><td colspan=5>".substr($key,0,2). ". " . $conf{$key}."</td></tr>\n";

	print "<tr>";
	foreach my $num (1..5) {
	print "<td>$num</td>";
	}
	print "</tr>";

	print "<tr>";
	foreach my $num (1..5) {
	print "<td>";
	if ( $q_and_a_to_choosers{$key.'='.$num} ) {
	print $q_and_a_to_choosers{$key.'='.$num}."\n";
	} else {
	print " \n";
	}
	print "</td>";
	}
	print "</tr>";
	print "<tr><td colspan=5> </td></tr>\n";
	print "<tr><td colspan=5> </td></tr>\n";
	print "<tr><td colspan=5> </td></tr>\n";
	print "<tr><td colspan=5> </td></tr>\n";
	print "<tr><td colspan=5> </td></tr>\n";
	print "<tr><td colspan=5> </td></tr>\n";
	}
	print "</table>";

	exit;
	}

	if ($q->param('submit')) {
	open( OUT_F, ">>$results_file") or die "Cannot open $results_file as output\n" ;
	my @names = $q->param; my $c = 0;
	foreach my $name (sort @names) { $c++; print OUT_F $q->param('first_name') . " for question $name selected ", $q->param($name),"\n"; }
	print "Thanks " . $q->param('first_name') ;
	exit;
	}

	print '<br><br>';
	print '<form>';
	print '<input type="hidden" name="game" value="'.$game.'">';
	print '<input type="hidden" name="submit" value="true">';
	print 'Your first name in Hebrew: <input type="text" name="first_name" value=""><br/>';
	foreach my $key (sort keys %conf) {
	#print "$key = $conf{$key}<br>\n";
	print $conf{$key}.'<br>'."\n";
	foreach my $num (1..5) {
	print '<input type="radio" name="'.$key.'" value="'.$num.'">'.$num.'<br>'."\n";
	}
	}
	print '<input type="submit" value="Submit">';
	print '</form>';
	exit;
	###############################################################################
	sub slurp {
	my $file = shift;
	open my $fh, '<', $file or die "can not find $file";
	local $/ = undef;
	my $cont = <$fh>;
	close $fh;
	return $cont;
	}