From 0277521b268b21caf0ee21202b92784f302baadc Mon Sep 17 00:00:00 2001
From: Michele Calgaro <michele.calgaro@yahoo.it>
Date: Sun, 15 Nov 2020 19:23:30 +0800
Subject: DEB: adjusted to new 'core' folder for main packages.

Signed-off-by: Michele Calgaro <michele.calgaro@yahoo.it>
---
 dilos/core/tdeedu/debian/keduca-shrinker | 154 +++++++++++++++++++++++++++++++
 1 file changed, 154 insertions(+)
 create mode 100644 dilos/core/tdeedu/debian/keduca-shrinker

(limited to 'dilos/core/tdeedu/debian/keduca-shrinker')

diff --git a/dilos/core/tdeedu/debian/keduca-shrinker b/dilos/core/tdeedu/debian/keduca-shrinker
new file mode 100644
index 000000000..188b3e0ef
--- /dev/null
+++ b/dilos/core/tdeedu/debian/keduca-shrinker
@@ -0,0 +1,154 @@
+#!/usr/bin/perl
+#
+# Copyright (c) 2005 Mathieu Roy <yeupou--gnu.org>
+# http://yeupou.coleumes.org
+#
+#   This program is free software; you can redistribute it and/or modify
+#   it under the terms of the GNU General Public License as published by
+#   the Free Software Foundation; either version 2 of the License, or
+#   (at your option) any later version.
+#
+#   This program is distributed in the hope that it will be useful,
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#   GNU General Public License for more details.
+#
+#   You should have received a copy of the GNU General Public License
+#   along with this program; if not, write to the Free Software
+#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
+#   USA
+#
+# $Id: keduca-shrinker.pl,v 1.3 2005/04/23 11:30:50 yeupou Exp $
+
+use Getopt::Long;
+
+my $getopt;
+my $debug; 
+my $help;
+
+my $input;
+my $output;
+my $number = "20";
+
+
+########### Get options, give help
+
+eval {
+    $getopt = GetOptions("debug" => \$debug,
+			 "help" => \$help,
+			 "number=s" => \$number,
+			 "input=s" => \$input,
+			 "output=s" => \$ouput);
+};
+
+if ($help) {
+    print STDERR <<EOF;
+Usage: $0 [OPTION] --input [FILE] 
+
+A small program that take a kdeduca test file (.edu) as input with say 100
+question and output a kdeduca test file with 20 questions selected randomly. 
+
+    -i, --input=FILE          Input keduca file.
+    -o, --output=FILE         Output keduca file, shrinked.
+                              (By default, the suffix -shrinked will be added)
+    -n, --number=NUMBER       Number expected of questions, in the shrinked
+                              version.
+                              ($number by default)
+ 
+Project Homepage: https://gna.org/projects/keduca-shrinker/
+EOF
+exit(1);
+}
+
+# Test input file existence
+unless ($input) {
+    print "No input file.\n";
+}
+unless (-r $input) {
+    print "Input file not readable.\n";
+    exit;
+}
+open(INPUT, "< $input");
+
+# Test output writability
+unless ($output) {
+    $output = $input;
+    $output =~ s/.edu$//;
+    $output .= "-shrinked.edu";
+}
+if (-e $output && ! -w $output) {
+    print "Output file not writable.\n";
+    exit;
+
+}
+open(OUTPUT, "> $output");
+
+########### Define subs
+
+sub fisher_yates_shuffle {
+    my $table = shift;
+    my $i;
+    for ($i = @$table; --$i;) {
+	my $j = int rand($i+1);
+	next if $i == $j;
+	@$table[$i,$j] = @$table[$j,$i];
+    }
+}
+
+
+########### Grab the file header, store questions in an array.
+# I know, it's XML, it may be simple to call an xml parser.
+# But in fact, we have nothing to parse here, we do not care about
+# the real content, so...
+my $structure = "header";
+my $header;
+my $footer;
+my @questions;
+my $newquestion;
+
+while (<INPUT>) {
+    ## Grab the structure (footer and header)
+    # the header last when data begins
+    # the footer begin when data ends
+
+    $header .= $_ if $structure eq "header";
+
+    $structure = "content" if /\<Data\>/m;
+    $structure = "footer" if /\<\/Data\>/m;
+
+    $footer .= $_ if $structure eq "footer";
+
+    ## Grab the questions
+    if ($structure eq "content") {
+	$newquestion .= $_;
+	
+	# If we found the string </question>, that the end of a question
+	if (/\<\/question\>/m) {
+	    push(@questions, $newquestion);
+	    $newquestion = "";
+	}
+	
+    }
+}
+
+########### Select the number of questions we want
+# warn the user if there's nothing to do
+if (scalar(@questions) < $number) {
+    print "There are only ".scalar(@questions)." questions in the input file, less than $number.\n";
+    # Copy & exit
+    system("cp", $input, $output);
+    exit;
+} else {
+    # Shuffle
+    fisher_yates_shuffle(\@questions);
+    # Keeps only the desired amount (number-1, as 0 is counted)
+    $#questions = ($number-1);
+}
+
+########### Final output
+print OUTPUT $header;
+print OUTPUT @questions;
+print OUTPUT $footer;
+
+close(INPUT);
+close(OUTPUT);
-- 
cgit v1.2.1