version 1.11, 2000/12/02 20:55:16
|
version 1.21, 2001/03/29 21:45:06
|
Line 5
|
Line 5
|
# |
# |
# 05/29/00,05/30,10/11 Gerd Kortemeyer) |
# 05/29/00,05/30,10/11 Gerd Kortemeyer) |
# |
# |
# 11/28,11/29,11/30,12/01,12/02 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 Gerd Kortemeyer |
|
|
package Apache::lonpublisher; |
package Apache::lonpublisher; |
|
|
use strict; |
use strict; |
use Apache::File; |
use Apache::File; |
|
use File::Copy; |
use Apache::Constants qw(:common :http :methods); |
use Apache::Constants qw(:common :http :methods); |
use HTML::TokeParser; |
use HTML::TokeParser; |
use Apache::lonxml; |
use Apache::lonxml; |
use Apache::structuretags; |
use Apache::lonhomework; |
use Apache::response; |
|
|
|
my %addid; |
my %addid; |
my %nokey; |
my %nokey; |
Line 25 my %cprtag;
|
Line 27 my %cprtag;
|
my %metadatafields; |
my %metadatafields; |
my %metadatakeys; |
my %metadatakeys; |
|
|
|
my $docroot; |
|
|
|
# ----------------------------------------------- Evaluate string with metadata |
|
|
sub metaeval { |
sub metaeval { |
my $metastring=shift; |
my $metastring=shift; |
|
|
Line 60 sub metaeval {
|
Line 66 sub metaeval {
|
} |
} |
} |
} |
|
|
|
# -------------------------------------------------------- Read a metadata file |
|
|
sub metaread { |
sub metaread { |
my ($logfile,$fn)=@_; |
my ($logfile,$fn)=@_; |
unless (-e $fn) { |
unless (-e $fn) { |
Line 76 sub metaread {
|
Line 84 sub metaread {
|
return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>'; |
return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>'; |
} |
} |
|
|
|
# --------------------------------------------------------- Various form fields |
|
|
sub textfield { |
sub textfield { |
my ($title,$name,$value)=@_; |
my ($title,$name,$value)=@_; |
return "\n<p><b>$title:</b><br>". |
return "\n<p><b>$title:</b><br>". |
Line 98 sub selectbox {
|
Line 108 sub selectbox {
|
return $selout.'</select>'; |
return $selout.'</select>'; |
} |
} |
|
|
|
# -------------------------------------------------------- Publication Step One |
|
|
sub publish { |
sub publish { |
|
|
my ($source,$target,$style)=@_; |
my ($source,$target,$style)=@_; |
Line 116 sub publish {
|
Line 128 sub publish {
|
|
|
# ----------------------------------------------------------------- Backup Copy |
# ----------------------------------------------------------------- Backup Copy |
my $copyfile=$source.'.save'; |
my $copyfile=$source.'.save'; |
{ |
if (copy($source,$copyfile)) { |
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"; |
print $logfile "Copied original file to ".$copyfile."\n"; |
} else { |
} else { |
print $logfile "Unable to write backup ".$copyfile."\n"; |
print $logfile "Unable to write backup ".$copyfile.':'.$!."\n"; |
return "<font color=red>Failed to write backup copy, FAIL</font>"; |
return "<font color=red>Failed to write backup copy, $!,FAIL</font>"; |
} |
} |
# ------------------------------------------------------------- IDs and indices |
# ------------------------------------------------------------- IDs and indices |
|
|
Line 307 sub publish {
|
Line 314 sub publish {
|
my $chparms=''; |
my $chparms=''; |
map { |
map { |
if (($_=~/^parameter/) || ($_=~/^stores/)) { |
if (($_=~/^parameter/) || ($_=~/^stores/)) { |
unless (($metadatafields{$_}) || ($_=~/\.\w+$/)) { |
unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) { |
print $logfile 'Obsolete: '.$_."\n"; |
print $logfile 'Obsolete: '.$_."\n"; |
$chparms.=$_.' '; |
$chparms.=$_.' '; |
} |
} |
Line 350 sub publish {
|
Line 357 sub publish {
|
} |
} |
} ($textonly=~m/(\w+)/g); |
} ($textonly=~m/(\w+)/g); |
|
|
|
map { |
|
$keywords{$_}=1; |
|
} split(/\W+/,$metadatafields{'keywords'}); |
|
|
map { |
map { |
$keywordout.='<td><input type=checkbox name="'.$_.'"'; |
$keywordout.='<td><input type=checkbox name="key.'.$_.'"'; |
if ($metadatafields{'keywords'}=~/$_/) { |
if ($metadatafields{'keywords'}=~/$_/) { |
$keywordout.=' checked'; |
$keywordout.=' checked'; |
} |
} |
Line 369 sub publish {
|
Line 379 sub publish {
|
|
|
$scrout.=$keywordout; |
$scrout.=$keywordout; |
|
|
|
$scrout.=&textfield('Additional Keywords','addkey',''); |
|
|
$scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); |
$scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); |
|
|
$scrout.= |
$scrout.= |
Line 401 sub publish {
|
Line 413 sub publish {
|
'<p><input type="submit" value="Finalize Publication"></form>'; |
'<p><input type="submit" value="Finalize Publication"></form>'; |
} |
} |
|
|
|
# -------------------------------------------------------- Publication Step Two |
|
|
sub phasetwo { |
sub phasetwo { |
|
|
my ($source,$target,$style)=@_; |
my ($source,$target,$style)=@_; |
Line 422 sub phasetwo {
|
Line 436 sub phasetwo {
|
$metadatafields{'title'}=$ENV{'form.title'}; |
$metadatafields{'title'}=$ENV{'form.title'}; |
$metadatafields{'author'}=$ENV{'form.author'}; |
$metadatafields{'author'}=$ENV{'form.author'}; |
$metadatafields{'subject'}=$ENV{'form.subject'}; |
$metadatafields{'subject'}=$ENV{'form.subject'}; |
$metadatafields{'keywords'}=$ENV{'form.keywords'}; |
|
$metadatafields{'notes'}=$ENV{'form.notes'}; |
$metadatafields{'notes'}=$ENV{'form.notes'}; |
$metadatafields{'abstract'}=$ENV{'form.abstract'}; |
$metadatafields{'abstract'}=$ENV{'form.abstract'}; |
$metadatafields{'mime'}=$ENV{'form.mime'}; |
$metadatafields{'mime'}=$ENV{'form.mime'}; |
Line 431 sub phasetwo {
|
Line 444 sub phasetwo {
|
$metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'}; |
$metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'}; |
$metadatafields{'owner'}=$ENV{'form.owner'}; |
$metadatafields{'owner'}=$ENV{'form.owner'}; |
$metadatafields{'copyright'}=$ENV{'form.copyright'}; |
$metadatafields{'copyright'}=$ENV{'form.copyright'}; |
|
|
|
my $allkeywords=$ENV{'form.addkey'}; |
map { |
map { |
print $logfile "\n".$_.': '.$metadatafields{$_}. |
if ($_=~/^form\.key\.(\w+)/) { |
"\n".$_.'.keys: '.$metadatakeys{$_}; |
$allkeywords.=','.$1; |
} sort keys %metadatafields; |
} |
|
} keys %ENV; |
|
$allkeywords=~s/\W+/\,/; |
|
$allkeywords=~s/^\,//; |
|
$metadatafields{'keywords'}=$allkeywords; |
|
|
|
{ |
|
print $logfile "\nWrite metadata file for ".$source; |
|
my $mfh; |
|
unless ($mfh=Apache::File->new('>'.$source.'.meta')) { |
|
return |
|
'<font color=red>Could not write metadata, FAIL</font>'; |
|
} |
|
map { |
|
unless ($_=~/\./) { |
|
my $unikey=$_; |
|
$unikey=~/^([A-Za-z]+)/; |
|
my $tag=$1; |
|
$tag=~tr/A-Z/a-z/; |
|
print $mfh "\n\<$tag"; |
|
map { |
|
my $value=$metadatafields{$unikey.'.'.$_}; |
|
$value=~s/\"/\'\'/g; |
|
print $mfh ' '.$_.'="'.$value.'"'; |
|
} split(/\,/,$metadatakeys{$unikey}); |
|
print $mfh '>'.$metadatafields{$unikey}.'</'.$tag.'>'; |
|
} |
|
} sort keys %metadatafields; |
|
$scrout.='<p>Wrote Metadata'; |
|
print $logfile "\nWrote metadata"; |
|
} |
|
|
|
# ----------------------------------------------------------- Copy old versions |
|
|
|
if (-e $target) { |
|
my $filename; |
|
my $maxversion=0; |
|
$target=~/(.*)\/([^\/]+)\.(\w+)$/; |
|
my $srcf=$2; |
|
my $srct=$3; |
|
my $srcd=$1; |
|
unless ($srcd=~/^\/home\/httpd\/html\/res/) { |
|
print $logfile "\nPANIC: Target dir is ".$srcd; |
|
return "<font color=red>Invalid target directory, FAIL</font>"; |
|
} |
|
opendir(DIR,$srcd); |
|
while ($filename=readdir(DIR)) { |
|
if ($filename=~/$srcf\.(\d+)\.$srct$/) { |
|
$maxversion=($1>$maxversion)?$1:$maxversion; |
|
} |
|
} |
|
closedir(DIR); |
|
$maxversion++; |
|
$scrout.='<p>Creating old version '.$maxversion; |
|
print $logfile "\nCreating old version ".$maxversion; |
|
|
|
my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct; |
|
|
|
if (copy($target,$copyfile)) { |
|
print $logfile "Copied old target to ".$copyfile."\n"; |
|
$scrout.='<p>Copied old target file'; |
|
} else { |
|
print $logfile "Unable to write ".$copyfile.':'.$!."\n"; |
|
return "<font color=red>Failed to copy old target, $!, FAIL</font>"; |
|
} |
|
|
|
# --------------------------------------------------------------- Copy Metadata |
|
|
|
$copyfile=$copyfile.'.meta'; |
|
|
|
if (copy($target.'.meta',$copyfile)) { |
|
print $logfile "Copied old target metadata to ".$copyfile."\n"; |
|
$scrout.='<p>Copied old metadata'; |
|
} else { |
|
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; |
|
if (-e $target.'.meta') { |
|
return |
|
"<font color=red>Failed to write old metadata copy, $!, FAIL</font>"; |
|
} |
|
} |
|
|
|
|
|
} else { |
|
$scrout.='<p>Initial version'; |
|
print $logfile "\nInitial version"; |
|
} |
|
|
|
# ---------------------------------------------------------------- Write Source |
|
my $copyfile=$target; |
|
|
|
my @parts=split(/\//,$copyfile); |
|
my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; |
|
|
|
my $count; |
|
for ($count=5;$count<$#parts;$count++) { |
|
$path.="/$parts[$count]"; |
|
if ((-e $path)!=1) { |
|
print $logfile "\nCreating directory ".$path; |
|
$scrout.='<p>Created directory '.$parts[$count]; |
|
mkdir($path,0777); |
|
} |
|
} |
|
|
|
if (copy($source,$copyfile)) { |
|
print $logfile "Copied original source to ".$copyfile."\n"; |
|
$scrout.='<p>Copied source file'; |
|
} else { |
|
print $logfile "Unable to write ".$copyfile.':'.$!."\n"; |
|
return "<font color=red>Failed to copy source, $!, FAIL</font>"; |
|
} |
|
|
|
# --------------------------------------------------------------- Copy Metadata |
|
|
|
$copyfile=$copyfile.'.meta'; |
|
|
|
if (copy($source.'.meta',$copyfile)) { |
|
print $logfile "Copied original metadata to ".$copyfile."\n"; |
|
$scrout.='<p>Copied metadata'; |
|
} else { |
|
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; |
|
return |
|
"<font color=red>Failed to write metadata copy, $!, FAIL</font>"; |
|
} |
|
|
|
# --------------------------------------------------- Send update notifications |
|
|
|
{ |
|
|
|
my $filename; |
|
|
|
$target=~/(.*)\/([^\/]+)$/; |
|
my $srcf=$2; |
|
opendir(DIR,$1); |
|
while ($filename=readdir(DIR)) { |
|
if ($filename=~/$srcf\.(\w+)$/) { |
|
my $subhost=$1; |
|
if ($subhost ne 'meta') { |
|
$scrout.='<p>Notifying host '.$subhost.':'; |
|
print $logfile "\nNotifying host '.$subhost.':'"; |
|
my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); |
|
$scrout.=$reply; |
|
print $logfile $reply; |
|
} |
|
} |
|
} |
|
closedir(DIR); |
|
|
|
} |
|
|
|
# ---------------------------------------- Send update notifications, meta only |
|
|
|
{ |
|
|
|
my $filename; |
|
|
|
$target=~/(.*)\/([^\/]+)$/; |
|
my $srcf=$2.'.meta'; |
|
opendir(DIR,$1); |
|
while ($filename=readdir(DIR)) { |
|
if ($filename=~/$srcf\.(\w+)$/) { |
|
my $subhost=$1; |
|
if ($subhost ne 'meta') { |
|
$scrout.= |
|
'<p>Notifying host for metadata only '.$subhost.':'; |
|
print $logfile |
|
"\nNotifying host for metadata only '.$subhost.':'"; |
|
my $reply=&Apache::lonnet::critical( |
|
'update:'.$target.'.meta',$subhost); |
|
$scrout.=$reply; |
|
print $logfile $reply; |
|
} |
|
} |
|
} |
|
closedir(DIR); |
|
|
|
} |
|
|
|
# ------------------------------------------------ Provide link to new resource |
|
|
|
my $thisdistarget=$target; |
|
$thisdistarget=~s/^$docroot//; |
|
|
|
return $scrout. |
|
'<p><a href="'.$thisdistarget.'"><font size=+2>View Target</font></a>'; |
} |
} |
|
|
# ================================================================ Main Handler |
# ================================================================ Main Handler |
Line 472 sub handler {
|
Line 667 sub handler {
|
$fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; |
$fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; |
|
|
my $targetdir=''; |
my $targetdir=''; |
my $docroot=$r->dir_config('lonDocRoot'); |
$docroot=$r->dir_config('lonDocRoot'); |
if ($1 ne $ENV{'user.name'}) { |
if ($1 ne $ENV{'user.name'}) { |
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
' trying to publish unowned file '.$ENV{'form.filename'}. |
' trying to publish unowned file '.$ENV{'form.filename'}. |
Line 544 unless ($ENV{'form.phase'} eq 'two') {
|
Line 739 unless ($ENV{'form.phase'} eq 'two') {
|
$r->send_http_header; |
$r->send_http_header; |
|
|
$r->print('<html><head><title>LON-CAPA Publishing</title></head>'); |
$r->print('<html><head><title>LON-CAPA Publishing</title></head>'); |
$r->print('<body bgcolor="#FFFFFF">'); |
$r->print( |
|
'<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); |
my $thisfn=$fn; |
my $thisfn=$fn; |
|
|
# ------------------------------------------------------------- Individual file |
# ------------------------------------------------------------- Individual file |