version 1.95, 2002/09/16 13:05:50
|
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 { |
sub batchpublish { |
my ($r,$srcfile)=@_; |
my ($r,$srcfile,$targetfile)=@_; |
my $thisdisfn=$srcfile; |
my $thisdisfn=$srcfile; |
$thisdisfn=~s/\/home\/korte\/public_html\///; |
$thisdisfn=~s/\/home\/korte\/public_html\///; |
$srcfile=~s/\/+/\//g; |
$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>'); |
$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 { |
sub publishdirectory { |
my ($r,$fn,$thisdisfn)=@_; |
my ($r,$fn,$thisdisfn)=@_; |
$r->print('<h1>Directory <tt>'.$thisdisfn.'/</tt></h1>'); |
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. |
my $dirptr=16384; # Mask indicating a directory in stat.cmode. |
|
|
Line 1422 sub publishdirectory {
|
Line 1498 sub publishdirectory {
|
} |
} |
} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') && |
} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') && |
($filename!~/^[\#\.]/) && ($filename!~/\~$/)) { |
($filename!~/^[\#\.]/) && ($filename!~/\~$/)) { |
&batchpublish($r,$fn.'/'.$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(); |
$r->rflush(); |
} |
} |
} |
} |