version 1.12, 2000/12/04 12:27:58
|
version 1.18, 2001/03/22 22:41:01
|
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,12/04 Gerd Kortemeyer |
# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 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::inputtags; |
|
use Apache::response; |
|
|
|
my %addid; |
my %addid; |
my %nokey; |
my %nokey; |
Line 127 sub publish {
|
Line 126 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 295 sub publish {
|
Line 289 sub publish {
|
# -------------------------------------------------- Parse content for metadata |
# -------------------------------------------------- Parse content for metadata |
|
|
my $allmeta=Apache::lonxml::xmlparse('meta',$content); |
my $allmeta=Apache::lonxml::xmlparse('meta',$content); |
&metaeval($allmeta); |
# &metaeval($allmeta); |
|
|
# ---------------- Find and document discrepancies in the parameters and stores |
# ---------------- Find and document discrepancies in the parameters and stores |
|
|
Line 511 if (-e $target) {
|
Line 505 if (-e $target) {
|
|
|
my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct; |
my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct; |
|
|
{ |
if (copy($target,$copyfile)) { |
my $org=Apache::File->new($target); |
|
my $cop; |
|
unless ($cop=Apache::File->new('>'.$copyfile)) { |
|
print $logfile "Unable to open for write ".$copyfile."\n"; |
|
return "<font color=red>Failed to open '.$copyfile. |
|
', FAIL</font>"; |
|
} |
|
while (my $line=<$org>) { print $cop $line; } |
|
} |
|
if (-e $copyfile) { |
|
print $logfile "Copied old target to ".$copyfile."\n"; |
print $logfile "Copied old target to ".$copyfile."\n"; |
$scrout.='<p>Copied old target file'; |
$scrout.='<p>Copied old target file'; |
} else { |
} else { |
print $logfile "Unable to write ".$copyfile."\n"; |
print $logfile "Unable to write ".$copyfile.':'.$!."\n"; |
return "<font color=red>Failed to copy old target, FAIL</font>"; |
return "<font color=red>Failed to copy old target, $!, FAIL</font>"; |
} |
} |
|
|
# --------------------------------------------------------------- Copy Metadata |
# --------------------------------------------------------------- Copy Metadata |
|
|
$copyfile=$copyfile.'.meta'; |
$copyfile=$copyfile.'.meta'; |
{ |
|
my $org=Apache::File->new($target.'.meta'); |
if (copy($target.'.meta',$copyfile)) { |
my $cop=Apache::File->new('>'.$copyfile); |
print $logfile "Copied old target metadata to ".$copyfile."\n"; |
while (my $line=<$org>) { print $cop $line; } |
|
} |
|
if (-e $copyfile) { |
|
print $logfile "Copied old target metadata to ".$copyfile."\n"; |
|
$scrout.='<p>Copied old metadata'; |
$scrout.='<p>Copied old metadata'; |
} else { |
} else { |
print $logfile "Unable to write metadata ".$copyfile."\n"; |
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; |
return |
if (-e $target.'.meta') { |
"<font color=red>Failed to write old metadata copy, FAIL</font>"; |
return |
|
"<font color=red>Failed to write old metadata copy, $!, FAIL</font>"; |
|
} |
} |
} |
|
|
|
|
Line 568 if (-e $target) {
|
Line 550 if (-e $target) {
|
} |
} |
} |
} |
|
|
{ |
if (copy($source,$copyfile)) { |
my $org=Apache::File->new($source); |
|
my $cop; |
|
unless ($cop=Apache::File->new('>'.$copyfile)) { |
|
print $logfile "Unable to open for write ".$copyfile."\n"; |
|
return "<font color=red>Failed to open '.$copyfile. |
|
', FAIL</font>"; |
|
} |
|
while (my $line=<$org>) { print $cop $line; } |
|
} |
|
if (-e $copyfile) { |
|
print $logfile "Copied original source to ".$copyfile."\n"; |
print $logfile "Copied original source to ".$copyfile."\n"; |
$scrout.='<p>Copied source file'; |
$scrout.='<p>Copied source file'; |
} else { |
} else { |
print $logfile "Unable to write ".$copyfile."\n"; |
print $logfile "Unable to write ".$copyfile.':'.$!."\n"; |
return "<font color=red>Failed to copy source, FAIL</font>"; |
return "<font color=red>Failed to copy source, $!, FAIL</font>"; |
} |
} |
|
|
# --------------------------------------------------------------- Copy Metadata |
# --------------------------------------------------------------- Copy Metadata |
|
|
my $copyfile=$target.'.meta'; |
$copyfile=$copyfile.'.meta'; |
{ |
|
my $org=Apache::File->new($source.'.meta'); |
if (copy($source.'.meta',$copyfile)) { |
my $cop=Apache::File->new('>'.$copyfile); |
|
while (my $line=<$org>) { print $cop $line; } |
|
} |
|
if (-e $copyfile) { |
|
print $logfile "Copied original metadata to ".$copyfile."\n"; |
print $logfile "Copied original metadata to ".$copyfile."\n"; |
$scrout.='<p>Copied metadata'; |
$scrout.='<p>Copied metadata'; |
} else { |
} else { |
print $logfile "Unable to write metadata ".$copyfile."\n"; |
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; |
return |
return |
"<font color=red>Failed to write metadata copy, FAIL</font>"; |
"<font color=red>Failed to write metadata copy, $!, FAIL</font>"; |
} |
} |
|
|
# --------------------------------------------------- Send update notifications |
# --------------------------------------------------- Send update notifications |
Line 648 sub handler {
|
Line 616 sub handler {
|
return OK; |
return OK; |
} |
} |
|
|
|
unless ($ENV{'form.pubdir'}) { |
# -------------------------------------------------------------- Check filename |
# -------------------------------------------------------------- Check filename |
|
|
my $fn=$ENV{'form.filename'}; |
my $fn=$ENV{'form.filename'}; |
Line 741 unless ($ENV{'form.phase'} eq 'two') {
|
Line 710 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 |
Line 775 unless ($ENV{'form.phase'} eq 'two') {
|
Line 745 unless ($ENV{'form.phase'} eq 'two') {
|
|
|
} |
} |
$r->print('</body></html>'); |
$r->print('</body></html>'); |
|
} else { |
|
|
|
my $fn=$ENV{'form.filename'}; |
|
|
|
$fn=~s/\/[^\/]+$//; |
|
my $thisprefix=$fn; |
|
$thisprefix=~s/\/\~/\/priv\//; |
|
|
|
$fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; |
|
|
|
unless ($fn) { |
|
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
|
' trying to publish empty directory', $r->filename); |
|
return HTTP_NOT_FOUND; |
|
} |
|
|
|
# ----------------------------------------------------------- Start page output |
|
|
|
$r->content_type('text/html'); |
|
$r->send_http_header; |
|
|
|
$r->print('<html><head><title>LON-CAPA Publishing Directory</title></head>'); |
|
$r->print( |
|
'<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); |
|
|
|
my $thisdisfn=$fn; |
|
$thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///; |
|
|
|
$r->print('<h1>Publishing directory <tt>'.$thisdisfn.'</tt></h1>'); |
|
my $i=0; |
|
$r->print('<script>'); |
|
my $filename; |
|
opendir(DIR,$fn); |
|
while ($filename=readdir(DIR)) { |
|
$filename=~/\.(\w+)$/; |
|
if ((&Apache::lonnet::fileembstyle($1)) && ($1 ne 'meta')) { |
|
$r->print(<<ENDOPEN); |
|
pub$i=window.open("$thisprefix/$filename","LONCAPApub$i", |
|
"menubar=no,height=450,width=650"); |
|
ENDOPEN |
|
$i++; |
|
} |
|
} |
|
closedir(DIR); |
|
$r->print('</script>'); |
|
|
|
$r->print('</body></html>'); |
|
|
|
} |
return OK; |
return OK; |
} |
} |
|
|