# 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,12/02,12/04,12/23 Gerd Kortemeyer
# 03/23 Guy Albertelli
# 03/24,03/29,04/03 Gerd Kortemeyer
# 04/16/2001 Scott Harrison
# 05/03,05/05,05/07 Gerd Kortemeyer
# 05/28/2001 Scott Harrison
# 06/23,08/07 Gerd Kortemeyer
package Apache::lonpublisher;
use strict;
use Apache::File;
use File::Copy;
use Apache::Constants qw(:common :http :methods);
use HTML::TokeParser;
use Apache::lonxml;
use Apache::lonhomework;
use Apache::loncacc;
use DBI;
my %addid;
my %nokey;
my %language;
my %cprtag;
my %metadatafields;
my %metadatakeys;
my $docroot;
my $cuname;
my $cudom;
# ----------------------------------------------- Evaluate string with metadata
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]->{'package'})) {
$unikey.='_package_'.$token->[2]->{'package'};
}
if (defined($token->[2]->{'part'})) {
$unikey.='_'.$token->[2]->{'part'};
}
if (defined($token->[2]->{'id'})) {
$unikey.='_'.$token->[2]->{'id'};
}
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);
}
}
}
}
# -------------------------------------------------------- Read a metadata file
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.'';
}
# ---------------------------- convert 'time' format into a datetime sql format
sub sqltime {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(@_[0]);
$mon++; $year+=1900;
return "$year-$mon-$mday $hour:$min:$sec";
}
# --------------------------------------------------------- Various form fields
sub textfield {
my ($title,$name,$value)=@_;
return "\n
$title:
".
'';
}
sub hiddenfield {
my ($name,$value)=@_;
return "\n".'';
}
sub selectbox {
my ($title,$name,$value,%options)=@_;
my $selout="\n
$title:
".'';
}
# -------------------------------------------------------- Publication Step One
sub publish {
my ($source,$target,$style)=@_;
my $logfile;
my $scrout='';
my $allmeta='';
my $content='';
unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
return
'No write permission to user directory, FAIL';
}
print $logfile
"\n\n================= Publish ".localtime()." Phase One ================\n";
if (($style eq 'ssi') || ($style eq 'rat')) {
# ------------------------------------------------------- This needs processing
# ----------------------------------------------------------------- Backup Copy
my $copyfile=$source.'.save';
if (copy($source,$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 $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+$//;
$metadatafields{'owner'}=$cuname.'@'.$cudom;
# ------------------------------------------------ Check out directory hierachy
my $thisdisfn=$source;
$thisdisfn=~s/^\/home\/$cuname\///;
my @urlparts=split(/\//,$thisdisfn);
$#urlparts--;
my $currentpath='/home/'.$cuname.'/';
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
$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{$_.'.name'}) || ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { print $logfile 'Obsolete: '.$_."\n"; $chparms.=$_.' '; } } } sort keys %oldparmstores; if ($chparms) { $scrout.='
Obsolete parameters or stored values: '. $chparms; } } # ------------------------------------------------------- Now have all metadata $scrout.= '