[LON-CAPA-cvs] cvs: modules /matthew/DQC parse_fm_output.pl

[matthew]

matthew		Tue May 25 08:50:21 2004 EDT

  Added files:                 
    /modules/matthew/DQC	parse_fm_output.pl 
  Log:
  Routine to produce LON-CAPA homework problems from filemaker pro input file.
  
  

Index: modules/matthew/DQC/parse_fm_output.pl
+++ modules/matthew/DQC/parse_fm_output.pl
#!/usr/bin/perl -w
#
# $Id: parse_fm_output.pl,v 1.1 2004/05/25 12:50:20 matthew Exp $
#
# 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;
use Getopt::Long;
use IO::File;
use HTML::TokeParser;

my ($help,$verbose,$debug,$filename);
GetOptions(
           'help' => \$help,
           'verbose' => \$verbose,
           'debug'   => \$debug,
           'file=s'  => \$filename,
           );

if ($help || ! defined($filename)) {
    print <<"ENDHELP";
$0
Options:
   -help              Display this help
   -verbose           Output progress information
   -debug             Output debugging statements
   -file=filename     Specify the xml file to read data from
ENDHELP
    exit;
}

$verbose = 1 if ($debug);

if ($verbose) {
    print "filename:".$filename.$/;
}

if (! -e $filename) {
    die "File $filename does not exist\n";
}

my $infile;
if (! ($infile = IO::File->new($filename))) {
    die "Unable to open $filename for reading.\n";
}

my $parser = HTML::TokeParser->new($infile);
if (! defined($parser)) {
    die "Unable to start token parser on ".$filename."\n";
}

#
# Look for the file to start with <XML>
my $token = $parser->get_token;
if ($debug) { print "Found <XML>\n"; }
#
my $lastnum = undef;
my @Columns;
my @Data;
while ($token = $parser->get_token) {
    if ($token->[0] eq 'S') {
        if (uc($token->[1]) eq 'FIELD') {
            my $attributes = $token->[2];
            push (@Columns,{name => $attributes->{'name'},
                            type => $attributes->{'type'},
                            maxrepeat => $attributes->{'maxrepeat'},
                            emptyok => $attributes->{'emptyok'},
                        });
        } elsif (uc($token->[1]) eq 'ROW') {
            my $col = 0;
            my $data;
            if ($debug) {print 'Got a row'.$/;}
            while ($token = $parser->get_token) {
                if ($token->[0] eq 'E' && uc($token->[1]) eq 'ROW'){
                    last;
                } elsif ($token->[0] eq 'E' && uc($token->[1]) eq 'COL'){
                    $col++;
                } elsif ($token->[0] eq 'T') {
                    $data->{$Columns[$col]->{'name'}}.=$token->[1];
                }
            }
            push (@Data,$data);
        }

    }
}

undef $token;
undef $parser;
undef $infile;

my $dir = 'DQCproblems'; 
if (! -d $dir) {
    system("mkdir $dir");
}

foreach my $data (@Data) {
    if (! exists($data->{'Answer'})) { $data->{'Answer'} = ''; }
    $data->{'Question'} =~ s/\015/\012/g;
    my $file = $data->{'Question ID'};
    $file =~ s/(\s+$|^\s+)//g;
    $file =~ s/\s+/_/g;
    $file =  $dir.'/'.$file.'.problem';
    my $outfile;
    if (! ($outfile = IO::File->new('>'.$file))) {
        die "Unable to open $file for writing.\n";
    }
    my $metatags;
    foreach my $field (
                       'Question ID',
                       'Answer',
                       'Class',
                       'Class 1',
                       'Class 2',
                       'Class 3',
                       'Created Date',
                       'Data File',
                       'Developer',
                       'Instructor 2',
                       'Instructor 3',
                       'Instructor1',
                       'Level => Organisms',
                       'Model Elements',
                       'Question type',
                       'Result',
                       'System',
                       'Test 1',
                       'Test 2',
                       'Test 3',
                       'Test Date',
                       'Test Date1',
                       'Test Date2',
                       'Test Date3',
                       'Topic',
                       'Type') {
        if (exists($data->{$field}) && $data->{$field} ne '') {
            my $value = $data->{$field};
            $value =~ s/(\s+$|^\s)//g;            
            $metatags .= &metatag($field,$value
)."\n";
        }
    }
    print $outfile <<"END";
<problem>
<parserlib>../DQC.sty</parserlib>
<DQCcenter>
<DQCouterheader />
<part id="1">
<DQCheader />
<DQCsubheader />
<startouttext />
<p style="white-space: pre-wrap;">
$data->{'Question'}
</p>
<hr />
<b>Right answer = $data->{'Answer'}</b>
<endouttext />
<!-- Responses and such go below here -->

<!-- Make no changes below here -->
</part>
<DQCfooter />
</DQCcenter>
<div id="footer" />
$metatags
</problem>
END
    $outfile->close();
    print "Wrote $file\n";
}


sub metatag {
    my ($name,$value)=@_;
    return qq{<meta name="$name" content="$value" display="$name" />};
}