version 1.94, 2002/09/10 14:52:35
|
version 1.98, 2002/10/03 15:02:22
|
Line 469 sub get_subscribed_hosts {
|
Line 469 sub get_subscribed_hosts {
|
while ($filename=readdir(DIR)) { |
while ($filename=readdir(DIR)) { |
if ($filename=~/$srcf\.(\w+)$/) { |
if ($filename=~/$srcf\.(\w+)$/) { |
my $subhost=$1; |
my $subhost=$1; |
if ($subhost ne 'meta' && $subhost ne 'subscription') { |
if (($subhost ne 'meta' && $subhost ne 'subscription') && |
|
($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) { |
push(@subscribed,$subhost); |
push(@subscribed,$subhost); |
} |
} |
} |
} |
Line 480 sub get_subscribed_hosts {
|
Line 481 sub get_subscribed_hosts {
|
&Apache::lonnet::logthis("opened $target.subscription"); |
&Apache::lonnet::logthis("opened $target.subscription"); |
while (my $subline=<$sh>) { |
while (my $subline=<$sh>) { |
&Apache::lonnet::logthis("Trying $subline"); |
&Apache::lonnet::logthis("Trying $subline"); |
if ($subline =~ /(^\w+):/) { push(@subscribed,$1); } else { |
if ($subline =~ /(^\w+):/) { |
|
if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) { |
|
push(@subscribed,$1); |
|
} |
|
} else { |
&Apache::lonnet::logthis("No Match for $subline"); |
&Apache::lonnet::logthis("No Match for $subline"); |
} |
} |
} |
} |
Line 805 I<Additional documentation needed.>
|
Line 810 I<Additional documentation needed.>
|
######################################### |
######################################### |
sub publish { |
sub publish { |
|
|
my ($source,$target,$style)=@_; |
my ($source,$target,$style,$batch)=@_; |
my $logfile; |
my $logfile; |
my $scrout=''; |
my $scrout=''; |
my $allmeta=''; |
my $allmeta=''; |
Line 896 sub publish {
|
Line 901 sub publish {
|
|
|
my %oldparmstores=(); |
my %oldparmstores=(); |
|
|
|
unless ($batch) { |
$scrout.='<h3>Metadata Information ' . |
$scrout.='<h3>Metadata Information ' . |
Apache::loncommon::help_open_topic("Metadata_Description") |
Apache::loncommon::help_open_topic("Metadata_Description") |
. '</h3>'; |
. '</h3>'; |
|
} |
|
|
# ------------------------------------------------ First, check out environment |
# ------------------------------------------------ First, check out environment |
unless (-e $source.'.meta') { |
unless (-e $source.'.meta') { |
Line 993 sub publish {
|
Line 999 sub publish {
|
|
|
# ------------------------------------------------------- Now have all metadata |
# ------------------------------------------------------- Now have all metadata |
|
|
|
my %keywords=(); |
|
|
|
if (length($content)<500000) { |
|
my $textonly=$content; |
|
$textonly=~s/\<script[^\<]+\<\/script\>//g; |
|
$textonly=~s/\<m\>[^\<]+\<\/m\>//g; |
|
$textonly=~s/\<[^\>]*\>//g; |
|
$textonly=~tr/A-Z/a-z/; |
|
$textonly=~s/[\$\&][a-z]\w*//g; |
|
$textonly=~s/[^a-z\s]//g; |
|
|
|
foreach ($textonly=~m/(\w+)/g) { |
|
unless ($nokey{$_}) { |
|
$keywords{$_}=1; |
|
} |
|
} |
|
} |
|
|
|
|
|
foreach (split(/\W+/,$metadatafields{'keywords'})) { |
|
$keywords{$_}=1; |
|
} |
|
# --------------------------------------------------- Now we also have keywords |
|
# ============================================================================= |
|
# INTERACTIVE MODE |
|
# |
|
unless ($batch) { |
$scrout.= |
$scrout.= |
'<form name="pubform" action="/adm/publish" method="post">'. |
'<form name="pubform" action="/adm/publish" method="post">'. |
'<p><input type="submit" value="Finalize Publication" /></p>'. |
'<p><input type="submit" value="Finalize Publication" /></p>'. |
Line 1028 function uncheckAll(field)
|
Line 1061 function uncheckAll(field)
|
END |
END |
$keywordout.='<table border=2><tr>'; |
$keywordout.='<table border=2><tr>'; |
my $colcount=0; |
my $colcount=0; |
my %keywords=(); |
|
|
|
if (length($content)<500000) { |
|
my $textonly=$content; |
|
$textonly=~s/\<script[^\<]+\<\/script\>//g; |
|
$textonly=~s/\<m\>[^\<]+\<\/m\>//g; |
|
$textonly=~s/\<[^\>]*\>//g; |
|
$textonly=~tr/A-Z/a-z/; |
|
$textonly=~s/[\$\&][a-z]\w*//g; |
|
$textonly=~s/[^a-z\s]//g; |
|
|
|
foreach ($textonly=~m/(\w+)/g) { |
|
unless ($nokey{$_}) { |
|
$keywords{$_}=1; |
|
} |
|
} |
|
} |
|
|
|
|
|
foreach (split(/\W+/,$metadatafields{'keywords'})) { |
|
$keywords{$_}=1; |
|
} |
|
|
|
foreach (sort keys %keywords) { |
foreach (sort keys %keywords) { |
$keywordout.='<td><input type=checkbox name="keywords" value="'.$_.'"'; |
$keywordout.='<td><input type=checkbox name="keywords" value="'.$_.'"'; |
Line 1123 END
|
Line 1134 END
|
$scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; |
$scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; |
return $scrout. |
return $scrout. |
'<p><input type="submit" value="Finalize Publication" /></p></form>'; |
'<p><input type="submit" value="Finalize Publication" /></p></form>'; |
|
# ============================================================================= |
|
# BATCH MODE |
|
# |
|
} else { |
|
# Transfer metadata directly to environment for stage 2 |
|
foreach (keys %metadatafields) { |
|
$ENV{'form.'.$_}=$metadatafields{$_}; |
|
} |
|
$ENV{'form.addkey'}=''; |
|
$ENV{'form.keywords'}=''; |
|
foreach (keys %keywords) { |
|
if ($metadatafields{'keywords'}) { |
|
if ($metadatafields{'keywords'}=~/$_/) { |
|
$ENV{'form.keywords'}.=$_.','; |
|
} |
|
} elsif (&Apache::loncommon::keyword($_)) { |
|
$ENV{'form.keywords'}.=$_.','; |
|
} |
|
} |
|
$ENV{'form.keywords'}=~s/\,$//; |
|
unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; } |
|
$ENV{'form.lastrevisiondate'}=time; |
|
if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) || |
|
(!$ENV{'form.copyright'})) { |
|
$ENV{'form.copyright'}='default'; |
|
} |
|
$ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta); |
|
return $scrout; |
|
} |
} |
} |
|
|
######################################### |
######################################### |
Line 1164 the server's attempts at publication.
|
Line 1204 the server's attempts at publication.
|
######################################### |
######################################### |
sub phasetwo { |
sub phasetwo { |
|
|
my ($source,$target,$style,$distarget)=@_; |
my ($source,$target,$style,$distarget,$batch)=@_; |
my $logfile; |
my $logfile; |
my $scrout=''; |
my $scrout=''; |
unless ($logfile=Apache::File->new('>>'.$source.'.log')) { |
unless ($logfile=Apache::File->new('>>'.$source.'.log')) { |
Line 1267 if (-e $target) {
|
Line 1307 if (-e $target) {
|
} |
} |
opendir(DIR,$srcd); |
opendir(DIR,$srcd); |
while ($filename=readdir(DIR)) { |
while ($filename=readdir(DIR)) { |
|
if (-l $srcd.'/'.$filename) { |
|
unlink($srcd.'/'.$filename); |
|
} else { |
if ($filename=~/$srcf\.(\d+)\.$srct$/) { |
if ($filename=~/$srcf\.(\d+)\.$srct$/) { |
$maxversion=($1>$maxversion)?$1:$maxversion; |
$maxversion=($1>$maxversion)?$1:$maxversion; |
} |
} |
|
} |
} |
} |
closedir(DIR); |
closedir(DIR); |
$maxversion++; |
$maxversion++; |
Line 1324 if (-e $target) {
|
Line 1368 if (-e $target) {
|
} |
} |
|
|
if (copy($source,$copyfile)) { |
if (copy($source,$copyfile)) { |
print $logfile "Copied original source to ".$copyfile."\n"; |
print $logfile "\nCopied 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 "\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>"; |
} |
} |
|
|
Line 1336 if (-e $target) {
|
Line 1380 if (-e $target) {
|
$copyfile=$copyfile.'.meta'; |
$copyfile=$copyfile.'.meta'; |
|
|
if (copy($source.'.meta',$copyfile)) { |
if (copy($source.'.meta',$copyfile)) { |
print $logfile "Copied original metadata to ".$copyfile."\n"; |
print $logfile "\nCopied 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 "\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>"; |
} |
} |
Line 1368 if (-e $target) {
|
Line 1412 if (-e $target) {
|
} |
} |
|
|
# ------------------------------------------------ Provide link to new resource |
# ------------------------------------------------ Provide link to new resource |
|
unless ($batch) { |
my $thisdistarget=$target; |
my $thisdistarget=$target; |
$thisdistarget=~s/^$docroot//; |
$thisdistarget=~s/^$docroot//; |
|
|
Line 1385 if (-e $target) {
|
Line 1429 if (-e $target) {
|
'<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'. |
'<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'. |
'<p><a href="'.$thissrcdir. |
'<p><a href="'.$thissrcdir. |
'"><font size="+2">Back to Source Directory</font></a>'; |
'"><font size="+2">Back to Source Directory</font></a>'; |
|
} else { |
|
return $warning.$scrout; |
|
} |
} |
} |
|
|
|
######################################### |
|
|
|
sub batchpublish { |
|
my ($r,$srcfile,$targetfile)=@_; |
|
my $thisdisfn=$srcfile; |
|
$thisdisfn=~s/\/home\/korte\/public_html\///; |
|
$srcfile=~s/\/+/\//g; |
|
|
|
my $docroot=$r->dir_config('lonDocRoot'); |
|
my $thisdistarget=$targetfile; |
|
$thisdistarget=~s/^$docroot//; |
|
|
|
|
|
undef %metadatafields; |
|
undef %metadatakeys; |
|
%metadatafields=(); |
|
%metadatakeys=(); |
|
$srcfile=~/\.(\w+)$/; |
|
my $thistype=$1; |
|
|
|
|
|
my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); |
|
|
|
$r->print('<h2>Publishing <tt>'.$thisdisfn.'</tt></h2>'); |
|
|
|
# phase one takes |
|
# my ($source,$target,$style,$batch)=@_; |
|
$r->print('<p>'.&publish($srcfile,$targetfile,$thisembstyle,1).'</p>'); |
|
# phase two takes |
|
# my ($source,$target,$style,$distarget,batch)=@_; |
|
# $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},... |
|
$r->print( |
|
'<p>'.&phasetwo($srcfile,$targetfile,$thisembstyle,$thisdistarget,1).'</p>'); |
|
return ''; |
|
} |
|
|
######################################### |
######################################### |
|
|
|
sub publishdirectory { |
|
my ($r,$fn,$thisdisfn)=@_; |
|
my $resdir= |
|
$Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname. |
|
$thisdisfn; |
|
$r->print('<h1>Directory <tt>'.$thisdisfn.'/</tt></h1>'. |
|
'Target: <tt>'.$resdir.'</tt><br />'); |
|
|
|
my $dirptr=16384; # Mask indicating a directory in stat.cmode. |
|
|
|
opendir(DIR,$fn); |
|
my @files=sort(readdir(DIR)); |
|
foreach my $filename (@files) { |
|
my ($cdev,$cino,$cmode,$cnlink, |
|
$cuid,$cgid,$crdev,$csize, |
|
$catime,$cmtime,$cctime, |
|
$cblksize,$cblocks)=stat($fn.'/'.$filename); |
|
|
|
my $extension=''; |
|
if ($filename=~/\.(\w+)$/) { $extension=$1; } |
|
if ($cmode&$dirptr) { |
|
if (($filename!~/^\./) && ($ENV{'form.pubrec'})) { |
|
&publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename); |
|
} |
|
} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') && |
|
($filename!~/^[\#\.]/) && ($filename!~/\~$/)) { |
|
# find out publication status and/or exiting metadata |
|
my $publishthis=0; |
|
if (-e $resdir.'/'.$filename) { |
|
my ($rdev,$rino,$rmode,$rnlink, |
|
$ruid,$rgid,$rrdev,$rsize, |
|
$ratime,$rmtime,$rctime, |
|
$rblksize,$rblocks)=stat($resdir.'/'.$filename); |
|
if ($rmtime<$cmtime) { |
|
# previously published, modified now |
|
$publishthis=1; |
|
} |
|
} else { |
|
# never published |
|
$publishthis=1; |
|
} |
|
if ($publishthis) { |
|
&batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename); |
|
} else { |
|
$r->print('<br />Skipping '.$filename.'<br />'); |
|
} |
|
$r->rflush(); |
|
} |
|
} |
|
closedir(DIR); |
|
} |
######################################### |
######################################### |
|
|
=pod |
=pod |
Line 1531 unless ($ENV{'form.phase'} eq 'two') {
|
Line 1664 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( |
$r->print(&Apache::loncommon::bodytag('Resource Publication')); |
'<body bgcolor="#FFFFFF"><img align="right" '. |
|
'src="/adm/lonIcons/lonlogos.gif" />'); |
|
my $thisfn=$fn; |
my $thisfn=$fn; |
|
|
# ---------------------- Evaluate individual file, and then output information. |
|
{ |
|
$thisfn=~/\.(\w+)$/; |
|
my $thistype=$1; |
|
my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); |
|
|
|
my $thistarget=$thisfn; |
my $thistarget=$thisfn; |
|
|
$thistarget=~s/^\/home/$targetdir/; |
$thistarget=~s/^\/home/$targetdir/; |
$thistarget=~s/\/public\_html//; |
$thistarget=~s/\/public\_html//; |
|
|
|
my $thisdistarget=$thistarget; |
|
$thisdistarget=~s/^$docroot//; |
|
|
|
my $thisdisfn=$thisfn; |
|
$thisdisfn=~s/^\/home\/$cuname\/public_html\///; |
|
|
my $thisdistarget=$thistarget; |
if ($fn=~/\/$/) { |
$thisdistarget=~s/^$docroot//; |
# -------------------------------------------------------- This is a directory |
|
&publishdirectory($r,$fn,$thisdisfn); |
|
|
my $thisdisfn=$thisfn; |
} else { |
$thisdisfn=~s/^\/home\/$cuname\/public_html\///; |
# ---------------------- Evaluate individual file, and then output information. |
|
$thisfn=~/\.(\w+)$/; |
|
my $thistype=$1; |
|
my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); |
|
|
$r->print('<h2>Publishing '. |
$r->print('<h2>Publishing '. |
&Apache::loncommon::filedescription($thistype).' <tt>'. |
&Apache::loncommon::filedescription($thistype).' <tt>'. |
$thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>'); |
'<a href="/~'.$cuname.'/'.$thisdisfn.'" target="cat">'.$thisdisfn. |
|
'</a></tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>'); |
|
|
if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) { |
if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) { |
$r->print('<h3><font color="red">Co-Author: '.$cuname.' at '.$cudom. |
$r->print('<h3><font color="red">Co-Author: '.$cuname.' at '.$cudom. |