#! /usr/bin/perl
# Copyright 2001-2024 Leslie Richardson
# This file is part of Open Admin for Schools.
# Create a data file for export to the FET timetabler.
my %lex = ('Export' => 'Export',
'Data' => 'Data',
'Main' => 'Main',
'Timetable' => 'Timetable',
'Dismissal' => 'Dismissal',
'No PPC match for subject' => 'No PPC match for subject',
'View/Download' => 'View/Download',
'Error' => 'Error',
);
my $self = 'exportfetdata.pl';
my $semester = 1; # fix later to allow semester selection.
my $year = '2012'; # used to create the 'year' group in student list.
use DBI;
use CGI;
use XML::Writer;
use XML::Writer::String;
use XML::LibXML;
# Read config variables
eval require "../../etc/admin.conf";
if ( $@ ) {
print $lex{Error}. ": $@ \n";
die $lex{Error}. ": $@\n";
}
my @constaintSameStartingTime;
my $sametime_ref = \@constaintSameStartingTime;
my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
my $q = new CGI;
my %arr = $q->Vars;
print $q->header( -charset, $charset );
# Print Page header.
my $title = "$lex{Export} FET $lex{Data}";
print qq{$doctype\n$title
$chartype\n\n};
print qq{[ $lex{Main} | };
print qq{$lex{Timetable} ]\n};
print qq{
$title
\n};
# Create Writer Instance
my $output = new XML::Writer::String;
my $datamode = 1; # pretty print...
my $wr = new XML::Writer(OUTPUT => $output,
DATA_MODE => $datamode,
DATA_INDENT => '3');
# Create top of XML data file.
#$wr->xmlDecl("UTF-8");
$wr->doctype('FET');
$wr->startTag('FET', 'version' => '4.1.6');
$wr->dataElement('Institution_Name',$schoolname);
$wr->dataElement('Comments','Created by Open Admin for Schools');
# setup table parameters.
mkHours_List();
mkDays_List();
# read data out of subject table....
mkTeachers_List();
mkSubjects_List();
# Not used yet...
# mkSubject_Tags_List();
# Check for Backings to create data structure read during student and activity generation.
# %backwith hash and %backgrade (for doing student group splits)
my $activityid = 1;
chkBackings();
mkStudents_List();
mkActivities_List();
mkTime_Constraints_List($sametime_ref);
$wr->endTag('FET');
$wr->end();
open (FH,">","fetdata.fet");
print FH $output->value;
close FH;
system("mv fetdata.fet $downloaddir");
print qq{
\n};
# End of Main
#---------------
sub mkHours_List {
#---------------
$wr->startTag('Hours_List');
unless (require "../../etc/schedule.conf") {
print "Cannot read schedule.conf: $!";
die "Cannot read schedule.conf: $!";
}
$wr->dataElement('Number',$#ptime);
for(1..$#ptime) {
$wr->dataElement('Name',$ptime[$_]);
}
$wr->dataElement('Name',$lex{Dismissal} );
$wr->endTag('Hours_List');
return;
}
#--------------
sub mkDays_List {
#--------------
# modify later to read values from schedule.conf file
$wr->startTag('Days_List');
$wr->dataElement('Number',6);
$wr->dataElement('Name','Day 1');
$wr->dataElement('Name','Day 2');
$wr->dataElement('Name','Day 3');
$wr->dataElement('Name','Day 4');
$wr->dataElement('Name','Day 5');
$wr->dataElement('Name','Day 6');
$wr->endTag('Days_List');
return;
}
#------------------
sub mkTeachers_List {
#------------------
my $sth = $dbh->prepare("select distinct teacher from subject order by teacher");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
$wr->startTag('Teachers_List');
while (my $tch = $sth->fetchrow) {
my ($tname, $userid) = split /\(/, $tch;
$userid =~ s/\)//; # strip closing bracket.
$wr->startTag('Teacher');
$wr->dataElement('Name', $userid);
$wr->endTag('Teacher');
}
$wr->endTag('Teachers_List');
return;
}
#------------------
sub mkSubjects_List {
#------------------
my $sth = $dbh->prepare("select description, subjsec from subject order by grade, description");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
$wr->startTag('Subjects_List');
while (my ($desc, $subjsec) = $sth->fetchrow) {
$desc =~ s/[()]//g;
$desc .= " ($subjsec)";
$wr->startTag('Subject');
$wr->dataElement('Name', $desc);
$wr->endTag('Subject');
}
$wr->endTag('Subjects_List');
return;
}
#----------------------
sub mkSubject_Tags_List {
#----------------------
$wr->startTag('Subject_Tags_List');
$wr->endTag('Subject_Tags_List');
return;
}
#--------------
sub chkBackings {
#--------------
# Read all subjects with backings.
my $sth = $dbh->prepare("select subjsec, backwith, grade
from subject where backwith != ''");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my @pool;
# Loop through backings and make backing pools in @pool
# put %poolindex values in as well
while (my ($subjsec, $backwith, $grade) = $sth->fetchrow ) {
if (not $poolindex{$subjsec}) {
push @pool, $subjsec;
$poolindex{$subjsec} = $#pool; # end of array;
}
@backs = split /\s+/, $backwith;
foreach my $bk (@backs) {
if (not $poolindex{$bk}) {
$pool[$poolindex{$subjsec}] .= " $bk";
$poolindex{$bk} = $poolindex{$subjsec};
}
}
}
# Testing only...
#foreach my $key (keys %poolindex) {
#print qq{K:$key V:$poolindex{$key} \n};
#}
#for my $idx (0..$#pool) {
#print qq{K:$idx P:$pool[$idx] \n};
#}
# We now have a completed @pool. (and %poolindex{subjsec})
# Each @pool element is a space separated list of subjsec's. (ie. 8019-1 6413-2)
# and should be scheduled at the same time...
foreach my $pool (@pool) {
my @bpool = split /\s+/, $pool; # get all subjsec's in pool
my @sglist = qw(A B C D E F G H); # list of subgroups.
my %studgrp; # index pointers into sglist;
# Get the number of periods for this pool.
my $fieldname = 'schedppc'. $semester;
my $sth = $dbh->prepare("select $fieldname from subject
where subjsec = ?");
my $schedppc;
foreach my $subjsec (@bpool) {
$sth->execute($subjsec);
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $ppc = $sth->fetchrow;
if ($schedppc == $ppc) {
next;
} else {
if (not $schedppc) {
$schedppc = $ppc;
} else { # No Match! Probably an error!
print $lex{'No PPC match for subject'}. " $subjsec \n";
}
}
} # $schedppc should now be set correctly...
# Loop through this number of periods, setting id's and then constraint id's.
my %constraintlist;
foreach my $subjsec (@bpool) { # loop through all subjects for each period.
# Get student group for this subjsec; studgrp{grade} = arrayoffset
my $sth = $dbh->prepare("select grade from subject where subjsec = '$subjsec'");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my $grade = $sth->fetchrow;
my @grades = split /\s/, $grade; # if multiple space separated grades.
my $studentgroups;
foreach my $gr (@grades) {
my $studgroup = 'Gr'.$gr.$sglist[$studgrp{$gr}]; # ie. A, B, C, etc.
$studentgroups .= "$studgroup ";
$studgrp{$gr}++; # increment to point to the next letter
if ($studgrp{$gr} > $globStudentIndex{$gr}) { $globStudentIndex{$gr} = $studgrp{$gr}; }
}
for my $period (1..$schedppc) {
if ($period == 1) { $groupid{$subjsec} = $activityid; }
$activity{"$subjsec:$period"} = "$activityid:$groupid{$subjsec}:$studentgroups";
$constraintlist{$period} .= "$activityid ";
$activityid++;
}
}
foreach my $period (sort keys %constraintlist) {
push @constaintSameStartingTime, $constraintlist{$period};
}
foreach my $subjsec (@bpool) {
# Need pool global hash of grade keys and offsets into the current studentgroup name
# studgrp{grade} = arrayoffset
my @grades = split /\s/, $grade; # if multiple space separated grades.
foreach my $gr (@grades) {
my $studgroup = 'Gr'.$gr.$subgroups[$studgrp{$gr}]; # ie. A, B, C, etc.
$studgrp{$gr}++; # increment to point to the next letter
}
}
} # End of Pool Loop.
# Test Activity Hash
#foreach my $key (sort keys %activity) {
# print qq{K: $key V: $activity{$key} \n};
#}
# print qq{Activity ID: $activityid \n};
# print qq{End of Activity Pool Test \n};
#Products - @constraintSameStartingTime - pools of ids that go together - same day,period.
# 2) %activity (subjsec:period) = aid:gid:studgroups - used to setup activities correctly.
# 3) %globStudentIndex{grade} = arrayindex - global hash to keep list of largest subgroup used.
#print qq{Global Index \n};
foreach my $key (keys %globStudentIndex) {
print qq{K:$key V: $globStudentIndex{$key} \n};
}
} # End of chkbackings
#------------------
sub mkStudents_List {
#------------------
my %grades;
# creates a grades hash with all grades in subject table.
my $sth = $dbh->prepare("select grade from subject where grade != ''");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
while (my $gradefield = $sth->fetchrow) {
my @grades = split /\s/,$gradefield;
foreach my $gr (@grades) {
$gr =~ s/\s//g; # remove space.
$grades{$gr} = 1;
}
}
my @grades = sort { $a <=> $b} keys %grades;
$wr->startTag('Students_List');
$wr->startTag('Year');
$wr->dataElement('Name', $year); # set at top of script.
foreach my $grade (@grades) {
$wr->startTag('Group');
$wr->dataElement('Name', "Gr$grade");
$wr->dataElement('Number_of_Students',$globStudentIndex{$grade});
my @sglist = qw(A B C D E F G H); # Subgroup extensions...
# Now create as many subgroups as required.
if (not exists($globStudentIndex{$grade}) ) { # just create 1 if no subgroups
$wr->startTag('Subgroup');
$wr->dataElement('Name', "Gr$grade WHOLE GROUP");
push @{$gradegroup{$grade}}, [ "Gr$grade WHOLE GROUP" ];
$wr->dataElement('Number_of_Students',1);
$wr->endTag('Subgroup');
} else { # We have some subgroups
my $endcounter = $globStudentIndex{$grade} - 1;
for (0..$endcounter) {
my $sg = $sglist[$_];
if ($_ == 0) {
push @{$gradegroup{$grade}}, [ "Gr$grade$sg" ];
} else {
push @{$gradegroup{$grade}}, "Gr$grade$sg";
}
$wr->startTag('Subgroup');
my $sg = shift @sglist;
$wr->dataElement('Name', "Gr$grade$sg");
$wr->dataElement('Number_of_Students',1);
$wr->endTag('Subgroup');
}
}
$wr->endTag('Group');
}
$wr->endTag('Year');
$wr->endTag('Students_List');
}
#--------------------
sub mkActivities_List {
#--------------------
# Note: All activity id's are stored in a hash that maps subjsec:period => id:gid
# The hash is called %activity
my $ppcfield = 'schedppc' . $semester; # semester set at top of script.
my $idcount = $activityid;
my $sth = $dbh->prepare("select id, description, subjsec, grade, teacher, $ppcfield
from subject order by description");
$sth->execute;
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
# setup for finding subject info.
my $sth2 = $dbh->prepare("select description, teacher, $ppcfield from subject where subjsec = ?");
$wr->startTag('Activities_List');
my %activityskip;
# Do the ones in %activity first; this is required for the backings...
foreach my $key (sort keys %activity) {
#print qq{K: $key V: $activity{$key} \n};
my ($subjsec, $period) = split /:/, $key;
my ($aid, $gid,$grp) = split /:/, $activity{$key};
my @grps = split /\s+/,$grp;
# Get subject information...
$sth2->execute($subjsec);
if ($DBI::errstr) { print $DBI::errstr; die $DBI::errstr; }
my ($desc, $tch, $ppc) = $sth2->fetchrow;
my ($tname, $userid) = split /\(/, $tch;
$userid =~ s/\)//; # strip closing bracket.
# write the record
$wr->startTag('Activity');
$wr->dataElement('Teacher', $userid);
$desc =~ s/[()]//g;
$desc .= " ($subjsec)";
$wr->dataElement('Subject', $desc);
$wr->dataElement('Id', $aid);
$wr->dataElement('Activity_Group_Id', $gid);
$wr->dataElement('Weekly', '');
$wr->dataElement('Duration', '1');
$wr->dataElement('Total_Duration', $ppc);
$wr->dataElement('Active', 'yes');
# Student Groups!
foreach my $gr (@grps) {
$wr->dataElement('Students', $gr);
}
$wr->endTag('Activity');
$activityskip{$subjsec} = 1; # set subjsec to skip below since done here.
}
while ( my ($id, $desc, $subjsec, $grade, $tch, $ppc) = $sth->fetchrow ) {
# ppc is Periods per Cycle.
if ( $activityskip{$subjsec} ) { next; } # skip if this subjsec done above.
my ($tname, $userid) = split /\(/, $tch;
$userid =~ s/\)//; # strip closing bracket.
my $gid = $idcount;
@grade = split /\s/, $grade;
# %activityid hash contains pointer subjsec and ids of activity record in anon array.
$activityid{$subjsec} = [ $idcount ];
# strip any parentheses in description and then add subjsec to end.
$desc =~ s/[()]//g;
$desc .= " ($subjsec)";
for my $count (1..$ppc) {
if ($count != 1) { push @{$activityid{$subjsec}}, $idcount; }
$wr->startTag('Activity');
$wr->dataElement('Teacher', $userid);
$wr->dataElement('Subject', $desc);
$wr->dataElement('Id', $idcount);
$wr->dataElement('Activity_Group_Id', $gid);
$wr->dataElement('Weekly', '');
$wr->dataElement('Duration', '1');
$wr->dataElement('Total_Duration', $ppc);
$wr->dataElement('Active', 'yes');
foreach my $gr (@grade) {
$wr->dataElement('Students', "Gr$gr");
}
$wr->endTag('Activity');
$idcount++;
}
}
$wr->endTag('Activities_List');
#~~ Print out Activity Id hash to verify...
# foreach my $subjsec (sort keys %activityid) {
# my $array_ref = $activityid{$subjsec};
# print qq{Subjsec: $subjsec Ids: ", @{$array_ref},"\n};
# }
}
#--------------------
sub mkEquipments_List {
#--------------------
}
#-------------------
sub mkBuildings_List {
#-------------------
}
#---------------
sub mkRooms_List {
#---------------
}
#--------------------------
sub mkTime_Constraints_List {
#--------------------------
my $cs_ref = shift;
$wr->startTag('Time_Constraints_List');
$wr->startTag('ConstraintBasicCompulsoryTime');
$wr->dataElement('Weight', '1');
$wr->dataElement('Compulsory', 'yes');
$wr->endTag('ConstraintBasicCompulsoryTime');
foreach my $conslist (@{$cs_ref}) {
print qq{CL: $conslist \n};
$wr->startTag('ConstraintActivitiesSameStartingTime');
$wr->dataElement('Weight', '1');
$wr->dataElement('Compulsory', 'yes');
my @idlist = split /\s/, $conslist;
$wr->dataElement('Number_of_Activities', $#idlist + 1);
foreach my $id (@idlist) {
$wr->dataElement('Activity_Id', $id);
}
$wr->endTag('ConstraintActivitiesSameStartingTime');
}
$wr->endTag('Time_Constraints_List');
#
#1
#yes
#3
#7
#11
#15
#1
#
#
# ConstraintTeacherNotAvailable
# ConstraintActivityPreferredTime
# Constraint
# Constraint
# Constraint
}
#---------------------------
sub mkSpace_Constraints_List {
#---------------------------
}