# The LearningOnline Network with CAPA
# Publication Handler
#
# (TeX Content Handler
#
# 05/29/00,05/30,10/11 Gerd Kortemeyer)
#
# 11/28,11/29,11/30,12/01 Gerd Kortemeyer
package Apache::lonpublisher;
use strict;
use Apache::File;
use Apache::Constants qw(:common :http :methods);
use HTML::TokeParser;
use Apache::lonxml;
use Apache::lonhomework;
my %addid;
my %nokey;
my %metadatafields;
my %metadatakeys;
sub metaeval {
my $metastring=shift;
my $parser=HTML::TokeParser->new(\$metastring);
my $token;
while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {
my $entry=$token->[1];
my $unikey=$entry;
if (defined($token->[2]->{'part'})) {
$unikey.='_'.$token->[2]->{'part'};
}
if (defined($token->[2]->{'name'})) {
$unikey.='_'.$token->[2]->{'name'};
}
map {
$metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
if ($metadatakeys{$unikey}) {
$metadatakeys{$unikey}.=','.$_;
} else {
$metadatakeys{$unikey}=$_;
}
} @{$token->[3]};
if ($metadatafields{$unikey}) {
my $newentry=$parser->get_text('/'.$entry);
unless ($metadatafields{$unikey}=~/$newentry/) {
$metadatafields{$unikey}.=', '.$newentry;
}
} else {
$metadatafields{$unikey}=$parser->get_text('/'.$entry);
}
}
}
}
sub metaread {
my ($logfile,$fn)=@_;
unless (-e $fn) {
print $logfile 'No file '.$fn."\n";
return '
No file: '.$fn.'';
}
print $logfile 'Processing '.$fn."\n";
my $metastring;
{
my $metafh=Apache::File->new($fn);
$metastring=join('',<$metafh>);
}
&metaeval($metastring);
return '
Processed file: '.$fn.'';
}
sub textfield {
my ($title,$value)=@_;
return "\n
$title:
".
'';
}
sub publish {
my ($source,$target,$style)=@_;
my $logfile;
my $scrout='';
unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
return
'No write permission to user directory, FAIL';
}
print $logfile
"\n\n================== Publish ".localtime()." =================\n";
if (($style eq 'ssi') || ($style eq 'rat')) {
# ------------------------------------------------------- This needs processing
# ----------------------------------------------------------------- Backup Copy
my $copyfile=$source.'.save';
{
my $org=Apache::File->new($source);
my $cop=Apache::File->new('>'.$copyfile);
while (my $line=<$org>) { print $cop $line; }
}
if (-e $copyfile) {
print $logfile "Copied original file to ".$copyfile."\n";
} else {
print $logfile "Unable to write backup ".$copyfile."\n";
return "Failed to write backup copy, FAIL";
}
# ------------------------------------------------------------- IDs and indices
my $maxindex=10;
my $maxid=10;
my $content='';
my $needsfixup=0;
{
my $org=Apache::File->new($source);
$content=join('',<$org>);
}
{
my $parser=HTML::TokeParser->new(\$content);
my $token;
while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {
my $counter;
if ($counter=$addid{$token->[1]}) {
if ($counter eq 'id') {
if (defined($token->[2]->{'id'})) {
$maxid=
($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
} else {
$needsfixup=1;
}
} else {
if (defined($token->[2]->{'index'})) {
$maxindex=
($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
} else {
$needsfixup=1;
}
}
}
}
}
}
if ($needsfixup) {
print $logfile "Needs ID and/or index fixup\n".
"Max ID : $maxid (min 10)\n".
"Max Index: $maxindex (min 10)\n";
my $outstring='';
my $parser=HTML::TokeParser->new(\$content);
my $token;
while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {
my $counter;
if ($counter=$addid{$token->[1]}) {
if ($counter eq 'id') {
if (defined($token->[2]->{'id'})) {
$outstring.=$token->[4];
} else {
$maxid++;
my $thisid=' id="'.$maxid.'"';
my $fixup=$token->[4];
$fixup=~s/(\<\w+)/$1$thisid/;
$outstring.=$fixup;
print $logfile 'ID: '.$fixup."\n";
}
} else {
if (defined($token->[2]->{'index'})) {
$outstring.=$token->[4];
} else {
$maxindex++;
my $thisindex=' index="'.$maxindex.'"';
my $fixup=$token->[4];
$fixup=~s/(\<\w+)/$1$thisindex/;
$outstring.=$fixup;
print $logfile 'Index: '.$fixup."\n";
}
}
} else {
$outstring.=$token->[4];
}
} elsif ($token->[0] eq 'E') {
$outstring.=$token->[2];
} else {
$outstring.=$token->[1];
}
}
{
my $org;
unless ($org=Apache::File->new('>'.$source)) {
print $logfile "No write permit to $source\n";
return
"No write permission to $source, FAIL";
}
print $org $outstring;
}
$content=$outstring;
print $logfile "End of ID and/or index fixup\n".
"Max ID : $maxid (min 10)\n".
"Max Index: $maxindex (min 10)\n";
} else {
print $logfile "Does not need ID and/or index fixup\n";
}
# --------------------------------------------- Initial step done, now metadata
# ---------------------------------------- Storage for metadata keys and fields
%metadatafields=();
%metadatakeys=();
my %oldparmstores=();
# ------------------------------------------------ First, check out environment
unless (-e $source.'.meta') {
$metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
$ENV{'environment.middlename'}.' '.
$ENV{'environment.lastname'}.' '.
$ENV{'environment.generation'};
$metadatafields{'author'}=~s/\s+/ /g;
$metadatafields{'author'}=~s/\s+$//;
# ------------------------------------------------ Check out directory hierachy
my $thisdisfn=$source;
$thisdisfn=~s/^\/home\/$ENV{'user.name'}\///;
my @urlparts=split(/\//,$thisdisfn);
$#urlparts--;
my $currentpath='/home/'.$ENV{'user.name'}.'/';
map {
$currentpath.=$_.'/';
$scrout.=&metaread($logfile,$currentpath.'default.meta');
} @urlparts;
# ------------------- Clear out parameters and stores (there should not be any)
map {
if (($_=~/^parameter/) || ($_=~/^stores/)) {
delete $metadatafields{$_};
}
} keys %metadatafields;
} else {
# ---------------------- Read previous metafile, remember parameters and stores
$scrout.=&metaread($logfile,$source.'.meta');
map {
if (($_=~/^parameter/) || ($_=~/^stores/)) {
$oldparmstores{$_}=1;
delete $metadatafields{$_};
}
} keys %metadatafields;
}
# -------------------------------------------------- Parse content for metadata
my $allmeta='';
if ($source=~/\.problem$/) {
$allmeta=Apache::lonhomework::subhandler('meta',$content);
} else {
$allmeta=Apache::lonxml::xmlparse('meta',$content);
}
&metaeval($allmeta);
# ---------------- Find and document discrepancies in the parameters and stores
my $chparms='';
map {
if (($_=~/^parameter/) || ($_=~/^stores/)) {
unless ($_=~/\.\w+$/) {
unless ($oldparmstores{$_}) {
print $logfile 'New: '.$_."\n";
$chparms.=$_.' ';
}
}
}
} sort keys %metadatafields;
if ($chparms) {
$scrout.='
New parameters or stored values: '. $chparms; } my $chparms=''; map { if (($_=~/^parameter/) || ($_=~/^stores/)) { unless (($metadatafields{$_}) || ($_=~/\.\w+$/)) { print $logfile 'Obsolete: '.$_."\n"; $chparms.=$_.' '; } } } sort keys %oldparmstores; if ($chparms) { $scrout.='
Obsolete parameters or stored values: '. $chparms; } # ------------------------------------------------------- Now have all metadata $scrout.= '