version 1.12, 2000/12/04 12:27:58
|
version 1.24, 2001/04/16 20:02:50
|
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 |
|
# 03/23 Guy Albertelli |
|
# 03/24,03/29,04/03 Gerd Kortemeyer |
|
# 04/16/2001 Scott Harrison |
|
|
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 DBI; |
use Apache::response; |
|
|
|
my %addid; |
my %addid; |
my %nokey; |
my %nokey; |
Line 114 sub publish {
|
Line 117 sub publish {
|
my ($source,$target,$style)=@_; |
my ($source,$target,$style)=@_; |
my $logfile; |
my $logfile; |
my $scrout=''; |
my $scrout=''; |
|
my $allmeta=''; |
|
my $content=''; |
|
|
unless ($logfile=Apache::File->new('>>'.$source.'.log')) { |
unless ($logfile=Apache::File->new('>>'.$source.'.log')) { |
return |
return |
Line 127 sub publish {
|
Line 132 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 |
|
|
my $maxindex=10; |
my $maxindex=10; |
my $maxid=10; |
my $maxid=10; |
my $content=''; |
|
my $needsfixup=0; |
my $needsfixup=0; |
|
|
{ |
{ |
Line 294 sub publish {
|
Line 294 sub publish {
|
|
|
# -------------------------------------------------- Parse content for metadata |
# -------------------------------------------------- Parse content for metadata |
|
|
my $allmeta=Apache::lonxml::xmlparse('meta',$content); |
$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 328 sub publish {
|
Line 328 sub publish {
|
$scrout.='<p><b>Obsolete parameters or stored values:</b> '. |
$scrout.='<p><b>Obsolete parameters or stored values:</b> '. |
$chparms; |
$chparms; |
} |
} |
|
} |
# ------------------------------------------------------- Now have all metadata |
# ------------------------------------------------------- Now have all metadata |
|
|
$scrout.= |
$scrout.= |
Line 412 sub publish {
|
Line 412 sub publish {
|
$scrout.=&selectbox('Copyright/Distribution','copyright', |
$scrout.=&selectbox('Copyright/Distribution','copyright', |
$metadatafields{'copyright'},%cprtag); |
$metadatafields{'copyright'},%cprtag); |
|
|
} |
|
return $scrout. |
return $scrout. |
'<p><input type="submit" value="Finalize Publication"></form>'; |
'<p><input type="submit" value="Finalize Publication"></form>'; |
} |
} |
Line 421 sub publish {
|
Line 420 sub publish {
|
|
|
sub phasetwo { |
sub phasetwo { |
|
|
my ($source,$target,$style)=@_; |
my ($source,$target,$style,$distarget)=@_; |
my $logfile; |
my $logfile; |
my $scrout=''; |
my $scrout=''; |
|
|
Line 485 sub phasetwo {
|
Line 484 sub phasetwo {
|
print $logfile "\nWrote metadata"; |
print $logfile "\nWrote metadata"; |
} |
} |
|
|
|
# -------------------------------- Synchronize entry with SQL metadata database |
|
my $dbh; |
|
{ |
|
unless ( |
|
$dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) |
|
) { |
|
return '<font color=red>Cannot connect to database!</font>'; |
|
} |
|
} |
|
|
|
my %sqldatafields; |
|
$sqldatafields{'url'}=$distarget; |
|
$sth=$dbh->prepare("delete from metadata where url like binary \"". |
|
$sqldatafields{'url'}."\""); |
|
$sth->execute(); |
|
map {my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g; |
|
$sqldatafields{$_}=$field;} |
|
('title','author','subject','keywords','notes','abstract', |
|
'mime','language','creationdate','lastrevisiondate','owner','copyright'); |
|
|
|
$sth=$dbh->prepare('insert into metadata values ('. |
|
'"'.delete($sqldatafields{'title'}).'"'.','. |
|
'"'.delete($sqldatafields{'author'}).'"'.','. |
|
'"'.delete($sqldatafields{'subject'}).'"'.','. |
|
'"'.delete($sqldatafields{'url'}).'"'.','. |
|
'"'.delete($sqldatafields{'keywords'}).'"'.','. |
|
'"'.'current'.'"'.','. |
|
'"'.delete($sqldatafields{'notes'}).'"'.','. |
|
'"'.delete($sqldatafields{'abstract'}).'"'.','. |
|
'"'.delete($sqldatafields{'mime'}).'"'.','. |
|
'"'.delete($sqldatafields{'language'}).'"'.','. |
|
'"'.delete($sqldatafields{'creationdate'}).'"'.','. |
|
'"'.delete($sqldatafields{'lastrevisiondate'}).'"'.','. |
|
'"'.delete($sqldatafields{'owner'}).'"'.','. |
|
'"'.delete($sqldatafields{'copyright'}).'"'.')'); |
|
$sth->execute(); |
|
$dbh->disconnect; |
|
$scrout.='<p>Synchronized SQL metadata database'; |
|
print $logfile "\nSynchronized SQL metadata database"; |
|
|
# ----------------------------------------------------------- Copy old versions |
# ----------------------------------------------------------- Copy old versions |
|
|
if (-e $target) { |
if (-e $target) { |
Line 511 if (-e $target) {
|
Line 550 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 595 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 628 if (-e $target) {
|
Line 641 if (-e $target) {
|
|
|
} |
} |
|
|
|
# ---------------------------------------- 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 |
# ------------------------------------------------ Provide link to new resource |
|
|
my $thisdistarget=$target; |
my $thisdistarget=$target; |
$thisdistarget=~s/^$docroot//; |
$thisdistarget=~s/^$docroot//; |
|
|
|
my $thissrc=$source; |
|
$thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/; |
|
|
|
my $thissrcdir=$thissrc; |
|
$thissrcdir=~s/\/[^\/]+$/\//; |
|
|
|
|
return $scrout. |
return $scrout. |
'<p><a href="'.$thisdistarget.'"><font size=+2>View Target</font></a>'; |
'<hr><a href="'.$thisdistarget.'"><font size=+2>View Target</font></a>'. |
|
'<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'. |
|
'<p><a href="'.$thissrcdir. |
|
'"><font size=+2>Back to Source Directory</font></a>'; |
|
|
} |
} |
|
|
# ================================================================ Main Handler |
# ================================================================ Main Handler |
Line 741 unless ($ENV{'form.phase'} eq 'two') {
|
Line 793 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 770 unless ($ENV{'form.phase'} eq 'two') {
|
Line 823 unless ($ENV{'form.phase'} eq 'two') {
|
unless ($ENV{'form.phase'} eq 'two') { |
unless ($ENV{'form.phase'} eq 'two') { |
$r->print('<hr>'.&publish($thisfn,$thistarget,$thisembstyle)); |
$r->print('<hr>'.&publish($thisfn,$thistarget,$thisembstyle)); |
} else { |
} else { |
$r->print('<hr>'.&phasetwo($thisfn,$thistarget,$thisembstyle)); |
$r->print('<hr>'.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget)); |
} |
} |
|
|
} |
} |