version 1.103, 2002/10/18 13:49:49
|
version 1.115, 2003/03/14 02:26:12
|
Line 33
|
Line 33
|
# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer |
# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer |
# 03/23 Guy Albertelli |
# 03/23 Guy Albertelli |
# 03/24,03/29,04/03 Gerd Kortemeyer |
# 03/24,03/29,04/03 Gerd Kortemeyer |
# 04/16/2001 Scott Harrison |
|
# 05/03,05/05,05/07 Gerd Kortemeyer |
# 05/03,05/05,05/07 Gerd Kortemeyer |
# 05/28/2001 Scott Harrison |
|
# 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer |
# 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer |
# 12/04,12/05 Guy Albertelli |
# 12/04,12/05 Guy Albertelli |
# 12/05 Gerd Kortemeyer |
# 12/05 Gerd Kortemeyer |
# 12/05 Guy Albertelli |
# 12/05 Guy Albertelli |
# 12/06,12/07 Gerd Kortemeyer |
# 12/06,12/07 Gerd Kortemeyer |
# 12/15,12/16 Scott Harrison |
|
# 12/25 Gerd Kortemeyer |
# 12/25 Gerd Kortemeyer |
# YEAR=2002 |
# YEAR=2002 |
# 1/16,1/17 Scott Harrison |
|
# 1/17 Gerd Kortemeyer |
# 1/17 Gerd Kortemeyer |
# |
# |
### |
### |
Line 121 use File::Copy;
|
Line 117 use File::Copy;
|
use Apache::Constants qw(:common :http :methods); |
use Apache::Constants qw(:common :http :methods); |
use HTML::LCParser; |
use HTML::LCParser; |
use Apache::lonxml; |
use Apache::lonxml; |
use Apache::lonhomework; |
|
use Apache::loncacc; |
use Apache::loncacc; |
use DBI; |
use DBI; |
use Apache::lonnet(); |
use Apache::lonnet(); |
use Apache::loncommon(); |
use Apache::loncommon(); |
use Apache::lonmysql; |
use Apache::lonmysql; |
|
use vars qw(%metadatafields %metadatakeys); |
|
|
my %addid; |
my %addid; |
my %nokey; |
my %nokey; |
|
|
my %metadatafields; |
|
my %metadatakeys; |
|
|
|
my $docroot; |
my $docroot; |
|
|
my $cuname; |
my $cuname; |
Line 262 sub metaread {
|
Line 255 sub metaread {
|
} |
} |
|
|
######################################### |
######################################### |
|
|
######################################### |
|
######################################### |
######################################### |
|
|
sub coursedependencies { |
sub coursedependencies { |
Line 492 sub get_max_ids_indices {
|
Line 483 sub get_max_ids_indices {
|
my $maxindex=10; |
my $maxindex=10; |
my $maxid=10; |
my $maxid=10; |
my $needsfixup=0; |
my $needsfixup=0; |
|
my $duplicateids=0; |
|
|
|
my %allids; |
|
my %duplicatedids; |
|
|
my $parser=HTML::LCParser->new($content); |
my $parser=HTML::LCParser->new($content); |
my $token; |
my $token; |
Line 502 sub get_max_ids_indices {
|
Line 497 sub get_max_ids_indices {
|
if ($counter eq 'id') { |
if ($counter eq 'id') { |
if (defined($token->[2]->{'id'})) { |
if (defined($token->[2]->{'id'})) { |
$maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid; |
$maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid; |
|
if (exists($allids{$token->[2]->{'id'}})) { |
|
$duplicateids=1; |
|
$duplicatedids{$token->[2]->{'id'}}=1; |
|
} else { |
|
$allids{$token->[2]->{'id'}}=1; |
|
} |
} else { |
} else { |
$needsfixup=1; |
$needsfixup=1; |
} |
} |
Line 515 sub get_max_ids_indices {
|
Line 516 sub get_max_ids_indices {
|
} |
} |
} |
} |
} |
} |
return ($needsfixup,$maxid,$maxindex); |
return ($needsfixup,$maxid,$maxindex,$duplicateids, |
|
(keys(%duplicatedids))); |
} |
} |
|
|
######################################### |
######################################### |
Line 547 sub get_all_text_unbalanced {
|
Line 549 sub get_all_text_unbalanced {
|
} elsif ($token->[0] eq 'E') { |
} elsif ($token->[0] eq 'E') { |
$result.=$token->[2]; |
$result.=$token->[2]; |
} |
} |
if ($result =~ /(.*)$tag(.*)/) { |
if ($result =~ /(.*)\Q$tag\E(.*)/s) { |
#&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2); |
#&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2); |
#&Apache::lonnet::logthis('Result is :'.$1); |
#&Apache::lonnet::logthis('Result is :'.$1); |
$result=$1; |
$result=$1; |
Line 584 sub fix_ids_and_indices {
|
Line 586 sub fix_ids_and_indices {
|
$content=join('',<$org>); |
$content=join('',<$org>); |
} |
} |
|
|
my ($needsfixup,$maxid,$maxindex)=&get_max_ids_indices(\$content); |
my ($needsfixup,$maxid,$maxindex,$duplicateids,@duplicatedids)= |
|
&get_max_ids_indices(\$content); |
|
|
|
print $logfile ("Got $needsfixup,$maxid,$maxindex,$duplicateids--". |
|
join(', ',@duplicatedids)); |
|
if ($duplicateids) { |
|
print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n"; |
|
my $outstring='<font color="red">Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are: '.join(', ',@duplicatedids).'</font>'; |
|
return ($outstring,1); |
|
} |
if ($needsfixup) { |
if ($needsfixup) { |
print $logfile "Needs ID and/or index fixup\n". |
print $logfile "Needs ID and/or index fixup\n". |
"Max ID : $maxid (min 10)\n". |
"Max ID : $maxid (min 10)\n". |
Line 709 sub fix_ids_and_indices {
|
Line 719 sub fix_ids_and_indices {
|
print $logfile "Does not need ID and/or index fixup\n"; |
print $logfile "Does not need ID and/or index fixup\n"; |
} |
} |
|
|
return ($outstring,%allow); |
return ($outstring,0,%allow); |
} |
} |
|
|
######################################### |
######################################### |
Line 779 This is the workhorse function of this m
|
Line 789 This is the workhorse function of this m
|
backup copies, performs any automatic processing (prior to publication, |
backup copies, performs any automatic processing (prior to publication, |
especially for rat and ssi files), |
especially for rat and ssi files), |
|
|
|
Returns a 2 element array, the first is the string to be shown to the |
|
user, the second is an error code, either 1 (an error occured) or 0 |
|
(no error occurred) |
|
|
I<Additional documentation needed.> |
I<Additional documentation needed.> |
|
|
=cut |
=cut |
Line 795 sub publish {
|
Line 809 sub publish {
|
my %allow=(); |
my %allow=(); |
|
|
unless ($logfile=Apache::File->new('>>'.$source.'.log')) { |
unless ($logfile=Apache::File->new('>>'.$source.'.log')) { |
return |
return ('<font color="red">No write permission to user directory, FAIL</font>',1); |
'<font color=red>No write permission to user directory, FAIL</font>'; |
|
} |
} |
print $logfile |
print $logfile |
"\n\n================= Publish ".localtime()." Phase One ================\n"; |
"\n\n================= Publish ".localtime()." Phase One ================\n"; |
Line 810 sub publish {
|
Line 823 sub publish {
|
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>",1); |
} |
} |
# ------------------------------------------------------------- IDs and indices |
# ------------------------------------------------------------- IDs and indices |
|
|
my $outstring; |
my ($outstring,$error); |
($outstring,%allow)=&fix_ids_and_indices($logfile,$source,$target); |
($outstring,$error,%allow)=&fix_ids_and_indices($logfile,$source, |
|
$target); |
|
if ($error) { return ($outstring,$error); } |
# ------------------------------------------------------------ Construct Allows |
# ------------------------------------------------------------ Construct Allows |
|
|
$scrout.='<h3>Dependencies</h3>'; |
$scrout.='<h3>Dependencies</h3>'; |
Line 860 sub publish {
|
Line 875 sub publish {
|
my $org; |
my $org; |
unless ($org=Apache::File->new('>'.$source)) { |
unless ($org=Apache::File->new('>'.$source)) { |
print $logfile "No write permit to $source\n"; |
print $logfile "No write permit to $source\n"; |
return |
return ('<font color="red">No write permission to '.$source. |
'<font color="red">No write permission to '.$source. |
', FAIL</font>',1); |
', FAIL</font>'; |
|
} |
} |
print($org $outstring); |
print($org $outstring); |
} |
} |
Line 1091 END
|
Line 1105 END
|
$metadatafields{'owner'}); |
$metadatafields{'owner'}); |
|
|
# -------------------------------------------------- Correct copyright for rat. |
# -------------------------------------------------- Correct copyright for rat. |
if ($style eq 'rat') { |
unless ($style eq 'prv') { |
|
if ($style eq 'rat') { |
if ($metadatafields{'copyright'} eq 'public') { |
if ($metadatafields{'copyright'} eq 'public') { |
delete $metadatafields{'copyright'}; |
delete $metadatafields{'copyright'}; |
} |
} |
Line 1099 END
|
Line 1114 END
|
$metadatafields{'copyright'}, |
$metadatafields{'copyright'}, |
\&Apache::loncommon::copyrightdescription, |
\&Apache::loncommon::copyrightdescription, |
(grep !/^public$/,(&Apache::loncommon::copyrightids))); |
(grep !/^public$/,(&Apache::loncommon::copyrightids))); |
} |
} else { |
else { |
|
$scrout.=&selectbox('Copyright/Distribution','copyright', |
$scrout.=&selectbox('Copyright/Distribution','copyright', |
$metadatafields{'copyright'}, |
$metadatafields{'copyright'}, |
\&Apache::loncommon::copyrightdescription, |
\&Apache::loncommon::copyrightdescription, |
(&Apache::loncommon::copyrightids)); |
(&Apache::loncommon::copyrightids)); |
} |
} |
|
|
my $copyright_help = |
my $copyright_help = |
Apache::loncommon::help_open_topic('Publishing_Copyright'); |
Apache::loncommon::help_open_topic('Publishing_Copyright'); |
$scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; |
$scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; |
return $scrout. |
$scrout.=&textfield('Custom Distribution File','customdistributionfile', |
'<p><input type="submit" value="Finalize Publication" /></p></form>'; |
$metadatafields{'customdistributionfile'}). |
|
$copyright_help; |
|
} else { |
|
$scrout.=&hiddenfield('copyright','private'); |
|
} |
|
return ($scrout.'<p><input type="submit" value="Finalize Publication" /></p></form>',0); |
# ============================================================================= |
# ============================================================================= |
# BATCH MODE |
# BATCH MODE |
# |
# |
Line 1139 END
|
Line 1158 END
|
$ENV{'form.copyright'}='default'; |
$ENV{'form.copyright'}='default'; |
} |
} |
$ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta); |
$ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta); |
return $scrout; |
return ($scrout,0); |
} |
} |
} |
} |
|
|
Line 1186 sub phasetwo {
|
Line 1205 sub phasetwo {
|
my ($r,$source,$target,$style,$distarget,$batch)=@_; |
my ($r,$source,$target,$style,$distarget,$batch)=@_; |
$source=~s/\/+/\//g; |
$source=~s/\/+/\//g; |
$target=~s/\/+/\//g; |
$target=~s/\/+/\//g; |
|
|
|
if ($target=~/\_\_\_/) { |
|
$r->print( |
|
'<font color="red">Unsupported character combination "<tt>___</tt>" in filename, FAIL</font>'); |
|
return 0; |
|
} |
$distarget=~s/\/+/\//g; |
$distarget=~s/\/+/\//g; |
my $logfile; |
my $logfile; |
unless ($logfile=Apache::File->new('>>'.$source.'.log')) { |
unless ($logfile=Apache::File->new('>>'.$source.'.log')) { |
return |
$r->print( |
'<font color=red>No write permission to user directory, FAIL</font>'; |
'<font color="red">No write permission to user directory, FAIL</font>'); |
|
return 0; |
} |
} |
print $logfile |
print $logfile |
"\n================= Publish ".localtime()." Phase Two ================\n"; |
"\n================= Publish ".localtime()." Phase Two ================\n"; |
Line 1211 sub phasetwo {
|
Line 1237 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'}; |
|
$metadatafields{'customdistributionfile'}= |
|
$ENV{'form.customdistributionfile'}; |
$metadatafields{'dependencies'}=$ENV{'form.dependencies'}; |
$metadatafields{'dependencies'}=$ENV{'form.dependencies'}; |
|
|
my $allkeywords=$ENV{'form.addkey'}; |
my $allkeywords=$ENV{'form.addkey'}; |
Line 1230 sub phasetwo {
|
Line 1258 sub phasetwo {
|
my $mfh; |
my $mfh; |
unless ($mfh=Apache::File->new('>'.$source.'.meta')) { |
unless ($mfh=Apache::File->new('>'.$source.'.meta')) { |
return |
return |
'<font color=red>Could not write metadata, FAIL</font>'; |
'<font color="red">Could not write metadata, FAIL</font>'; |
} |
} |
foreach (sort keys %metadatafields) { |
foreach (sort keys %metadatafields) { |
unless ($_=~/\./) { |
unless ($_=~/\./) { |
Line 1282 sub phasetwo {
|
Line 1310 sub phasetwo {
|
my $srcd=$1; |
my $srcd=$1; |
unless ($srcd=~/^\/home\/httpd\/html\/res/) { |
unless ($srcd=~/^\/home\/httpd\/html\/res/) { |
print $logfile "\nPANIC: Target dir is ".$srcd; |
print $logfile "\nPANIC: Target dir is ".$srcd; |
return "<font color=red>Invalid target directory, FAIL</font>"; |
return "<font color=\"red\">Invalid target directory, FAIL</font>"; |
} |
} |
opendir(DIR,$srcd); |
opendir(DIR,$srcd); |
while ($filename=readdir(DIR)) { |
while ($filename=readdir(DIR)) { |
Line 1307 sub phasetwo {
|
Line 1335 sub phasetwo {
|
$r->print('<p>Copied old target file'); |
$r->print('<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 |
Line 1321 sub phasetwo {
|
Line 1349 sub phasetwo {
|
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; |
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; |
if (-e $target.'.meta') { |
if (-e $target.'.meta') { |
return |
return |
"<font color=red>Failed to write old metadata copy, $!, FAIL</font>"; |
"<font color=\"red\">Failed to write old metadata copy, $!, FAIL</font>"; |
} |
} |
} |
} |
|
|
Line 1352 sub phasetwo {
|
Line 1380 sub phasetwo {
|
$r->print('<p>Copied source file'); |
$r->print('<p>Copied source file'); |
} else { |
} else { |
print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; |
print $logfile "\nUnable 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 |
Line 1365 sub phasetwo {
|
Line 1393 sub phasetwo {
|
} else { |
} else { |
print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; |
print $logfile "\nUnable 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>"; |
} |
} |
$r->rflush; |
$r->rflush; |
# --------------------------------------------------- Send update notifications |
# --------------------------------------------------- Send update notifications |
Line 1453 sub batchpublish {
|
Line 1481 sub batchpublish {
|
|
|
# phase one takes |
# phase one takes |
# my ($source,$target,$style,$batch)=@_; |
# my ($source,$target,$style,$batch)=@_; |
$r->print('<p>'.&publish($srcfile,$targetfile,$thisembstyle,1).'</p>'); |
my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1); |
|
$r->print('<p>'.$outstring.'</p>'); |
# phase two takes |
# phase two takes |
# my ($source,$target,$style,$distarget,batch)=@_; |
# my ($source,$target,$style,$distarget,batch)=@_; |
# $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},... |
# $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},... |
$r->print('<p>'); |
if (!$error) { |
&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1); |
$r->print('<p>'); |
$r->print('</p>'); |
&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1); |
|
$r->print('</p>'); |
|
} |
return ''; |
return ''; |
} |
} |
|
|
Line 1574 sub handler {
|
Line 1605 sub handler {
|
|
|
# -------------------------------------------------------------- Check filename |
# -------------------------------------------------------------- Check filename |
|
|
my $fn=$ENV{'form.filename'}; |
my $fn=&Apache::lonnet::unescape($ENV{'form.filename'}); |
|
|
|
|
unless ($fn) { |
unless ($fn) { |
Line 1698 unless ($ENV{'form.phase'} eq 'two') {
|
Line 1729 unless ($ENV{'form.phase'} eq 'two') {
|
if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { |
if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { |
$r->print('<br /><a href="/adm/diff?filename=/~'.$cuname.'/'. |
$r->print('<br /><a href="/adm/diff?filename=/~'.$cuname.'/'. |
$thisdisfn. |
$thisdisfn. |
'&versionone=priv" target="cat">Diffs with Current Version</a><p>'); |
'&versiontwo=priv" target="cat">Diffs with Current Version</a><p>'); |
} |
} |
|
|
# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. |
# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. |
|
|
unless ($ENV{'form.phase'} eq 'two') { |
unless ($ENV{'form.phase'} eq 'two') { |
$r->print( |
my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle); |
'<hr />'.&publish($thisfn,$thistarget,$thisembstyle)); |
$r->print('<hr />'.$outstring); |
} else { |
} else { |
$r->print('<hr />'); |
$r->print('<hr />'); |
&phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); |
&phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); |
} |
} |
|
|
} |
} |
$r->print('</body></html>'); |
$r->print('</body></html>'); |
|
|