[LON-CAPA-cvs] cvs: modules /gerd/ie ietrans.pl

[www]

www		Sat Apr  2 11:07:58 2005 EDT

  Added files:                 
    /modules/gerd/ie	ietrans.pl 
  Log:
  Script to translate Illinois IEs into LON-CAPA
  
  

Index: modules/gerd/ie/ietrans.pl
+++ modules/gerd/ie/ietrans.pl
# Translation program for IEs.
# $Id: ietrans.pl,v 1.1 2005/04/02 16:07:58 www Exp $
#
# Usage: perl ietrans.pl filename
#
# by Gerd Kortemeyer
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA 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.
#
# LON-CAPA 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 LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
use strict;
#
# Open file
#
my $filename=$ARGV[0];
unless ($filename=~/\.txt$/) { $filename.='.txt'; }
unless (open(IN,$filename)) {
    print "\nError: could not open file $filename\n";
    die;
}
#
# IEs use globals
#
my $rootproblemasked=0;
my $insideaquestion=0;
my $unit='';
my $answer='';
my @optiontext=();
my @optionvalue=();
#
# Setup LON-CAPA headers
#
print <<ENDHEADERS;
<problem>
<import>/res/msu/kortemey/physicslib/ie.library</import>
ENDHEADERS
#
# Main loop: look for tokens
#
while (my $line=<IN>) {
    if ($line=~/^\s*\$/) {
	&script($line);
    } elsif ($line=~/^\s*question/) {
        &question($line);
    } elsif ($line=~/^\s*answer/) {
        &remember('answer',$line);
    } elsif ($line=~/^\s*units/) {
        &remember('unit',$line);
    } elsif ($line=~/^\s*numerical/) {
        &makenumerical($line);
    } elsif ($line=~/^\s*right/) {
        &pushoption('true',$line);
    } elsif ($line=~/^\s*wrong/) {
        &pushoption('false',$line);
    } elsif ($line=~/^\s*radio/) {
        &makeradio($line);
    } elsif ($line=~/^\s*pause/) {
        &makepause($line);
    } elsif ($line=~/^\s*say/) {
        &say($line);
    } elsif ($line=~/^\s*\#/) {
        &comment($line);
    } elsif ($line!~/\w/) {
        print "\n";
    } else {
        print "\nError: Unrecognized $line\n";
        die;
    }
}
&endquestion();
print "\n<problem>\n";
#
# Done
#
# ====== Subroutines ======
#
# Fetch text between 'token "' and '";';
#
sub get_all_string {
    my $text=shift;
    my $firstline=$text;
# delete token itself
    $text=~s/^\w+\s*\"//;
# if text ends on same line, we are done
    if ($text=~/\"\;\s*$/s) {
	$text=~s/\"\;\s*$//s;
        return &xhtml($text);
    }
# get additional lines
    while (my $line=<IN>) {
        $text.=$line;
        if ($text=~/\"\;\s*$/s) {
	   $text=~s/\"\;\s*$//s;
           return &xhtml($text);
        }
    }
# we should not get here
    print "\nError: read to end of file while getting string: $firstline\n";
    die; 
}
#
# 
#
sub fix {
    my ($tag,$args)=@_;
    $tag=~tr/A-Z/a-z/;
    my $xhtml='<'.$tag;
    my $newargs='';
    foreach (split(/\s+/,$args)) {
        my ($attrib,$value)=split(/\=/,$_);
        unless ($attrib=~/\w/) { next; }
        $attrib=~tr/A-Z/a-z/;
# get quotes around it
        unless ($value=~/^[\"\']/) {
	    $value='"'.$value.'"';
	}
# LON-CAPA uses relative paths
        $value=~s/\/\$here\///;
        $xhtml.=' '.$attrib.'='.$value;
    }
# Empty tags need '/'
    if ($tag=~/^(img|hr|br)$/) { $xhtml.=' /'; }
    $xhtml.='>';
    return $xhtml;
}

#
# Convert HTML->XHTML where possible
#
sub xhtml {
    my $text=shift;
# Fix tags and their arguments
    $text=~s/\<(\w+)([^\>]*)\>/&fix($1,$2)/ge;
    return $text;
}
#
# produce outtext from string
#
sub say {
    print "\n<startouttext />\n".&get_all_string(shift)."\n<endouttext />\n";
}
#
# End last question, if there was one
#
sub endquestion {
    if ($insideaquestion) {
	if ($rootproblemasked) {
	    print "\n<\\followupifpreviouscorrect>\n";
        } else {
	    print "\n<\\rootproblem>\n";
            $rootproblemasked=1;
	}
    }
    $insideaquestion=0;
}
#
# start a new question
#
sub question {
    &endquestion();
    $insideaquestion=1;
    if ($rootproblemasked) {
	print "\n<followupifpreviouscorrect>\n";
    } else {
        print "\n<rootproblem>";
    }
    &say(shift);
}
#
# push option for radio response
#
sub pushoption {
    my ($value,$text)=@_;
    push @optionvalue,$value;
    push @optiontext,&say($text);
}
#
# Remember a global
#
sub remember {
    my ($what,$text)=@_;
    my ($value)=($text=~/\s(.+)\;/);
    $value=~s/\"//g;
    if ($what eq 'unit') { $unit=$value; }
    if ($what eq 'answer') { $answer=$value; }
}

sub makeradio {
}

sub makenumerical {
}

sub makepause {
}

sub script {
}

sub comment {
    my $text=shift;
    $text=~s/\s*$//s;
    $text=~s/\#//g;
    print "\n<!-- $text -->\n";
}