--- loncom/publisher/lonpublisher.pm 2000/11/29 19:52:34 1.3 +++ loncom/publisher/lonpublisher.pm 2001/12/04 18:10:37 1.55 @@ -1,48 +1,879 @@ # The LearningOnline Network with CAPA # Publication Handler +# +# $Id: lonpublisher.pm,v 1.55 2001/12/04 18:10:37 sakharuk Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# # # (TeX Content Handler # # 05/29/00,05/30,10/11 Gerd Kortemeyer) # -# 11/28,11/29 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 +# 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 package Apache::lonpublisher; use strict; use Apache::File; +use File::Copy; use Apache::Constants qw(:common :http :methods); use HTML::TokeParser; +use Apache::lonxml; +use Apache::lonhomework; +use Apache::loncacc; +use DBI; my %addid; +my %nokey; +my %language; +my %cprtag; + +my %metadatafields; +my %metadatakeys; + +my $docroot; + +my $cuname; +my $cudom; + +# ----------------------------------------------- Evaluate string with metadata + +sub metaeval { + my $metastring=shift; + + my $parser=HTML::TokeParser->new(\$metastring); + my $token; + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + my $entry=$token->[1]; + my $unikey=$entry; + if (defined($token->[2]->{'package'})) { + $unikey.='_package_'.$token->[2]->{'package'}; + } + if (defined($token->[2]->{'part'})) { + $unikey.='_'.$token->[2]->{'part'}; + } + if (defined($token->[2]->{'id'})) { + $unikey.='_'.$token->[2]->{'id'}; + } + if (defined($token->[2]->{'name'})) { + $unikey.='_'.$token->[2]->{'name'}; + } + map { + $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_}; + if ($metadatakeys{$unikey}) { + $metadatakeys{$unikey}.=','.$_; + } else { + $metadatakeys{$unikey}=$_; + } + } @{$token->[3]}; + if ($metadatafields{$unikey}) { + my $newentry=$parser->get_text('/'.$entry); + unless (($metadatafields{$unikey}=~/$newentry/) || + ($newentry eq '')) { + $metadatafields{$unikey}.=', '.$newentry; + } + } else { + $metadatafields{$unikey}=$parser->get_text('/'.$entry); + } + } + } +} + +# -------------------------------------------------------- Read a metadata file + +sub metaread { + my ($logfile,$fn)=@_; + unless (-e $fn) { + print $logfile 'No file '.$fn."\n"; + return '
No file: '.$fn.''; + } + print $logfile 'Processing '.$fn."\n"; + my $metastring; + { + my $metafh=Apache::File->new($fn); + $metastring=join('',<$metafh>); + } + &metaeval($metastring); + return '
Processed file: '.$fn.''; +} + +# ---------------------------- convert 'time' format into a datetime sql format +sub sqltime { + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = + localtime(@_[0]); + $mon++; $year+=1900; + return "$year-$mon-$mday $hour:$min:$sec"; +} + +# --------------------------------------------------------- Various form fields + +sub textfield { + my ($title,$name,$value)=@_; + return "\n

$title:
". + ''; +} + +sub hiddenfield { + my ($name,$value)=@_; + return "\n".''; +} + +sub selectbox { + my ($title,$name,$value,%options)=@_; + my $selout="\n

$title:
".''; +} + +# -------------------------------------------------------- Publication Step One + +sub urlfixup { + my ($url,$target)=@_; + unless ($url) { return ''; } + my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/); + map { + if ($_ eq $host) { + $url=~s/^http\:\/\///; + $url=~s/^$host//; + } + } values %Apache::lonnet::hostname; + if ($url=~/^http\:\/\//) { return $url; } + $url=~s/\~$cuname/res\/$cudom\/$cuname/; + if ($target) { + $target=~s/\/[^\/]+$//; + $url=&Apache::lonnet::hreflocation($target,$url); + } + return $url; +} sub publish { + my ($source,$target,$style)=@_; my $logfile; + my $scrout=''; + my $allmeta=''; + my $content=''; + my %allow=(); + undef %allow; + unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - return 'No write permission to user directory, FAIL'; + return + 'No write permission to user directory, FAIL'; } print $logfile -"\n\n================== Publish ".localtime()." =================\n"; +"\n\n================= Publish ".localtime()." Phase One ================\n"; if (($style eq 'ssi') || ($style eq 'rat')) { # ------------------------------------------------------- This needs processing + +# ----------------------------------------------------------------- Backup Copy my $copyfile=$source.'.save'; + if (copy($source,$copyfile)) { + print $logfile "Copied original file to ".$copyfile."\n"; + } else { + print $logfile "Unable to write backup ".$copyfile.':'.$!."\n"; + return "Failed to write backup copy, $!,FAIL"; + } +# ------------------------------------------------------------- IDs and indices + + my $maxindex=10; + my $maxid=10; + + my $needsfixup=0; + { - my $org=Apache::File->new($source); - my $cop=Apache::File->new('>'.$copyfile); - while (my $line=<$org>) { print $cop $line; } + my $org=Apache::File->new($source); + $content=join('',<$org>); } - if (-e $copyfile) { - print $logfile "Copied original file to ".$copyfile."\n"; + { + my $parser=HTML::TokeParser->new(\$content); + my $token; + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + my $counter; + if ($counter=$addid{$token->[1]}) { + if ($counter eq 'id') { + if (defined($token->[2]->{'id'})) { + $maxid= + ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid; + } else { + $needsfixup=1; + } + } else { + if (defined($token->[2]->{'index'})) { + $maxindex= + ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex; + } else { + $needsfixup=1; + } + } + } + } + } + } + if ($needsfixup) { + print $logfile "Needs ID and/or index fixup\n". + "Max ID : $maxid (min 10)\n". + "Max Index: $maxindex (min 10)\n"; + } + my $outstring=''; + my $parser=HTML::TokeParser->new(\$content); + $parser->xml_mode(1); + my $token; + while ($token=$parser->get_token) { + if ($token->[0] eq 'S') { + my $counter; + my $tag=$token->[1]; + my $lctag=$tag;$lctag=~s/[A-Z]/[a-z]/g; + unless ($lctag eq 'allow') { + my %parms=%{$token->[2]}; + $counter=$addid{$tag}; + if (!$counter) { $counter=$addid{$lctag}; } + if ($counter) { + if ($counter eq 'id') { + unless (defined($parms{'id'})) { + $maxid++; + $parms{'id'}=$maxid; + print $logfile 'ID: '.$tag.':'.$maxid."\n"; + } + } elsif ($counter eq 'index') { + unless (defined($parms{'index'})) { + $maxindex++; + $parms{'index'}=$maxindex; + print $logfile 'Index: '.$tag.':'.$maxindex."\n"; + } + } + } + + map { + if (defined($parms{$_})) { + my $oldurl=$parms{$_}; + my $newurl=&urlfixup($oldurl,$target); + if ($newurl ne $oldurl) { + $parms{$_}=$newurl; + print $logfile 'URL: '.$tag.':'.$oldurl.' - '. + $newurl."\n"; + } + $allow{$newurl}=1; + } + } ('src','href','background'); + + if ($lctag eq 'applet') { + my $codebase=''; + if (defined($parms{'codebase'})) { + my $oldcodebase=$parms{'codebase'}; + unless ($oldcodebase=~/\/$/) { + $oldcodebase.='/'; + } + $codebase=&urlfixup($oldcodebase,$target); + $codebase=~s/\/$//; + if ($codebase ne $oldcodebase) { + $parms{'codebase'}=$codebase; + print $logfile 'URL codebase: '.$tag.':'. + $oldcodebase.' - '. + $codebase."\n"; + } + $allow{$codebase.'/*'}=1; + } else { + map { + if (defined($parms{$_})) { + my $oldurl=$parms{$_}; + my $newurl=&urlfixup($oldurl,$target); + $newurl=~s/\/[^\/]+$/\/\*/; + print $logfile 'Allow: applet '.$_.':'. + $oldurl.' allows '. + $newurl."\n"; + $allow{$newurl}=1; + } + } ('archive','code','object'); + } + } + + my $newparmstring=''; + my $endtag=''; + map { + if ($_ eq '/') { + $endtag=' /'; + } else { + my $quote=($parms{$_}=~/\"/?"'":'"'); + $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote; + } + } keys %parms; + + $outstring.='<'.$tag.$newparmstring.$endtag.'>'; + } else { + $allow{$token->[2]->{'src'}}=1; + } + } elsif ($token->[0] eq 'E') { + unless ($token->[1] eq 'allow') { + $outstring.='[1].'>'; + } + } else { + $outstring.=$token->[1]; + } + } +# ------------------------------------------------------------ Construct Allows + unless ($style eq 'rat') { + $scrout.='

Dependencies

'; + my $allowstr="\n"; + map { + $allowstr.=''."\n"; + $scrout.='
'; + unless ($_=~/\*/) { + $scrout.=''; + } + $scrout.=''.$_.''; + unless ($_=~/\*/) { + $scrout.=''; + } + } keys %allow; + $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s; + } +# ------------------------------------------------------------- Write modified + + { + my $org; + unless ($org=Apache::File->new('>'.$source)) { + print $logfile "No write permit to $source\n"; + return + "No write permission to $source, FAIL"; + } + print $org $outstring; + } + $content=$outstring; + + if ($needsfixup) { + print $logfile "End of ID and/or index fixup\n". + "Max ID : $maxid (min 10)\n". + "Max Index: $maxindex (min 10)\n"; + } else { + print $logfile "Does not need ID and/or index fixup\n"; + } + } +# --------------------------------------------- Initial step done, now metadata + +# ---------------------------------------- Storage for metadata keys and fields + + %metadatafields=(); + %metadatakeys=(); + + my %oldparmstores=(); + + $scrout.='

Metadata Information

'; + +# ------------------------------------------------ First, check out environment + unless (-e $source.'.meta') { + $metadatafields{'author'}=$ENV{'environment.firstname'}.' '. + $ENV{'environment.middlename'}.' '. + $ENV{'environment.lastname'}.' '. + $ENV{'environment.generation'}; + $metadatafields{'author'}=~s/\s+/ /g; + $metadatafields{'author'}=~s/\s+$//; + $metadatafields{'owner'}=$cuname.'@'.$cudom; + +# ------------------------------------------------ Check out directory hierachy + + my $thisdisfn=$source; + $thisdisfn=~s/^\/home\/$cuname\///; + + my @urlparts=split(/\//,$thisdisfn); + $#urlparts--; + + my $currentpath='/home/'.$cuname.'/'; + + map { + $currentpath.=$_.'/'; + $scrout.=&metaread($logfile,$currentpath.'default.meta'); + } @urlparts; + +# ------------------- Clear out parameters and stores (there should not be any) + + map { + if (($_=~/^parameter/) || ($_=~/^stores/)) { + delete $metadatafields{$_}; + } + } keys %metadatafields; + + } else { +# ---------------------- Read previous metafile, remember parameters and stores + + $scrout.=&metaread($logfile,$source.'.meta'); + + map { + if (($_=~/^parameter/) || ($_=~/^stores/)) { + $oldparmstores{$_}=1; + delete $metadatafields{$_}; + } + } keys %metadatafields; + + } + +# -------------------------------------------------- Parse content for metadata + if ($style eq 'ssi') { + my $oldenv=$ENV{'request.uri'}; + + $ENV{'request.uri'}=$target; + $allmeta=Apache::lonxml::xmlparse('meta',$content); + $ENV{'request.uri'}=$oldenv; + + &metaeval($allmeta); + } +# ---------------- Find and document discrepancies in the parameters and stores + + my $chparms=''; + map { + if (($_=~/^parameter/) || ($_=~/^stores/)) { + unless ($_=~/\.\w+$/) { + unless ($oldparmstores{$_}) { + print $logfile 'New: '.$_."\n"; + $chparms.=$_.' '; + } + } + } + } sort keys %metadatafields; + if ($chparms) { + $scrout.='

New parameters or stored values: '. + $chparms; + } + + my $chparms=''; + map { + if (($_=~/^parameter/) || ($_=~/^stores/)) { + unless (($metadatafields{$_.'.name'}) || + ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { + print $logfile 'Obsolete: '.$_."\n"; + $chparms.=$_.' '; + } + } + } sort keys %oldparmstores; + if ($chparms) { + $scrout.='

Obsolete parameters or stored values: '. + $chparms; + } + +# ------------------------------------------------------- Now have all metadata + + $scrout.= + '

'. + &hiddenfield('phase','two'). + &hiddenfield('filename',$ENV{'form.filename'}). + &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)). + &textfield('Title','title',$metadatafields{'title'}). + &textfield('Author(s)','author',$metadatafields{'author'}). + &textfield('Subject','subject',$metadatafields{'subject'}); + +# --------------------------------------------------- Scan content for keywords + + my $keywordout='

Keywords:
'; + my $colcount=0; + + if (length($content)<500000) { + my $textonly=$content; + $textonly=~s/\//g; + $textonly=~s/\[^\<]+\<\/m\>//g; + $textonly=~s/\<[^\>]*\>//g; + $textonly=~tr/A-Z/a-z/; + $textonly=~s/[\$\&][a-z]\w*//g; + $textonly=~s/[^a-z\s]//g; + + my %keywords=(); + map { + unless ($nokey{$_}) { + $keywords{$_}=1; + } + } ($textonly=~m/(\w+)/g); + + map { + $keywords{$_}=1; + } split(/\W+/,$metadatafields{'keywords'}); + + map { + $keywordout.='\n"; + $colcount=0; + } + $colcount++; + } sort keys %keywords; + } else { - return "Failed to write backup copy, FAIL"; + $keywordout.=''; + } + + $keywordout.='
'; + if ($colcount>10) { + $keywordout.="
File too long for keyword analysis
'; + + $scrout.=$keywordout; + + $scrout.=&textfield('Additional Keywords','addkey',''); + + $scrout.=&textfield('Notes','notes',$metadatafields{'notes'}); + + $scrout.= + '

Abstract:
'; + + $source=~/\.(\w+)$/; + + $scrout.=&hiddenfield('mime',$1); + + $scrout.=&selectbox('Language','language', + $metadatafields{'language'},%language); + + unless ($metadatafields{'creationdate'}) { + $metadatafields{'creationdate'}=time; } + $scrout.=&hiddenfield('creationdate',$metadatafields{'creationdate'}); + + $scrout.=&hiddenfield('lastrevisiondate',time); + + + $scrout.=&textfield('Publisher/Owner','owner', + $metadatafields{'owner'}); +# --------------------------------------------------- Correct copyright for rat + if ($style eq 'rat') { + if ($metadatafields{'copyright'} eq 'public') { + delete $metadatafields{'copyright'}; + } + delete $cprtag{'public'}; + } + + $scrout.=&selectbox('Copyright/Distribution','copyright', + $metadatafields{'copyright'},%cprtag); + + return $scrout. + '

'; +} + +# -------------------------------------------------------- Publication Step Two + +sub phasetwo { + + my ($source,$target,$style,$distarget)=@_; + my $logfile; + my $scrout=''; + unless ($logfile=Apache::File->new('>>'.$source.'.log')) { + return + 'No write permission to user directory, FAIL'; + } + print $logfile +"\n================= Publish ".localtime()." Phase Two ================\n"; + + %metadatafields=(); + %metadatakeys=(); + + &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'})); + + $metadatafields{'title'}=$ENV{'form.title'}; + $metadatafields{'author'}=$ENV{'form.author'}; + $metadatafields{'subject'}=$ENV{'form.subject'}; + $metadatafields{'notes'}=$ENV{'form.notes'}; + $metadatafields{'abstract'}=$ENV{'form.abstract'}; + $metadatafields{'mime'}=$ENV{'form.mime'}; + $metadatafields{'language'}=$ENV{'form.language'}; + $metadatafields{'creationdate'}=$ENV{'form.creationdate'}; + $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'}; + $metadatafields{'owner'}=$ENV{'form.owner'}; + $metadatafields{'copyright'}=$ENV{'form.copyright'}; + + my $allkeywords=$ENV{'form.addkey'}; + map { + if ($_=~/^form\.key\.(\w+)/) { + $allkeywords.=','.$1; + } + } keys %ENV; + $allkeywords=~s/\W+/\,/; + $allkeywords=~s/^\,//; + $metadatafields{'keywords'}=$allkeywords; + + { + print $logfile "\nWrite metadata file for ".$source; + my $mfh; + unless ($mfh=Apache::File->new('>'.$source.'.meta')) { + return + 'Could not write metadata, FAIL'; + } + map { + unless ($_=~/\./) { + my $unikey=$_; + $unikey=~/^([A-Za-z]+)/; + my $tag=$1; + $tag=~tr/A-Z/a-z/; + print $mfh "\n\<$tag"; + map { + my $value=$metadatafields{$unikey.'.'.$_}; + $value=~s/\"/\'\'/g; + print $mfh ' '.$_.'="'.$value.'"'; + } split(/\,/,$metadatakeys{$unikey}); + print $mfh '>'.$metadatafields{$unikey}.''; + } + } sort keys %metadatafields; + $scrout.='

Wrote Metadata'; + print $logfile "\nWrote metadata"; + } + +# -------------------------------- Synchronize entry with SQL metadata database + my %perlvar; + open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; + my $configline; + while ($configline=) { + if ($configline =~ /PerlSetVar/) { + my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); + chomp($varvalue); + $perlvar{$varname}=$varvalue; + } } - my $version=''; + close(CONFIG); + + my $warning; + my $dbh; + { + unless ( + $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) + ) { + $warning='WARNING: Cannot connect to '. + 'database!'; + } + else { + my %sqldatafields; + $sqldatafields{'url'}=$distarget; + my $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'}).'"'.','. + '"'. + sqltime(delete($sqldatafields{'creationdate'})) + .'"'.','. + '"'. + sqltime(delete( + $sqldatafields{'lastrevisiondate'})).'"'.','. + '"'.delete($sqldatafields{'owner'}).'"'.','. + '"'.delete( + $sqldatafields{'copyright'}).'"'.')'); + $sth->execute(); + $dbh->disconnect; + $scrout.='

Synchronized SQL metadata database'; + print $logfile "\nSynchronized SQL metadata database"; + } + } + + +# ----------------------------------------------------------- Copy old versions - return 'Version '.$version.', SUCCESS'; +if (-e $target) { + my $filename; + my $maxversion=0; + $target=~/(.*)\/([^\/]+)\.(\w+)$/; + my $srcf=$2; + my $srct=$3; + my $srcd=$1; + unless ($srcd=~/^\/home\/httpd\/html\/res/) { + print $logfile "\nPANIC: Target dir is ".$srcd; + return "Invalid target directory, FAIL"; + } + opendir(DIR,$srcd); + while ($filename=readdir(DIR)) { + if ($filename=~/$srcf\.(\d+)\.$srct$/) { + $maxversion=($1>$maxversion)?$1:$maxversion; + } + } + closedir(DIR); + $maxversion++; + $scrout.='

Creating old version '.$maxversion; + print $logfile "\nCreating old version ".$maxversion; + + my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct; + + if (copy($target,$copyfile)) { + print $logfile "Copied old target to ".$copyfile."\n"; + $scrout.='

Copied old target file'; + } else { + print $logfile "Unable to write ".$copyfile.':'.$!."\n"; + return "Failed to copy old target, $!, FAIL"; + } + +# --------------------------------------------------------------- Copy Metadata + + $copyfile=$copyfile.'.meta'; + + if (copy($target.'.meta',$copyfile)) { + print $logfile "Copied old target metadata to ".$copyfile."\n"; + $scrout.='

Copied old metadata'; + } else { + print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; + if (-e $target.'.meta') { + return + "Failed to write old metadata copy, $!, FAIL"; + } + } + + +} else { + $scrout.='

Initial version'; + print $logfile "\nInitial version"; +} + +# ---------------------------------------------------------------- Write Source + my $copyfile=$target; + + my @parts=split(/\//,$copyfile); + my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; + + my $count; + for ($count=5;$count<$#parts;$count++) { + $path.="/$parts[$count]"; + if ((-e $path)!=1) { + print $logfile "\nCreating directory ".$path; + $scrout.='

Created directory '.$parts[$count]; + mkdir($path,0777); + } + } + + if (copy($source,$copyfile)) { + print $logfile "Copied original source to ".$copyfile."\n"; + $scrout.='

Copied source file'; + } else { + print $logfile "Unable to write ".$copyfile.':'.$!."\n"; + return "Failed to copy source, $!, FAIL"; + } + +# --------------------------------------------------------------- Copy Metadata + + $copyfile=$copyfile.'.meta'; + + if (copy($source.'.meta',$copyfile)) { + print $logfile "Copied original metadata to ".$copyfile."\n"; + $scrout.='

Copied metadata'; + } else { + print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; + return + "Failed to write metadata copy, $!, FAIL"; + } + +# --------------------------------------------------- Send update notifications + +{ + + my $filename; + + $target=~/(.*)\/([^\/]+)$/; + my $srcf=$2; + opendir(DIR,$1); + while ($filename=readdir(DIR)) { + if ($filename=~/$srcf\.(\w+)$/) { + my $subhost=$1; + if ($subhost ne 'meta') { + $scrout.='

Notifying host '.$subhost.':'; + print $logfile "\nNotifying host '.$subhost.':'"; + my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); + $scrout.=$reply; + print $logfile $reply; + } + } + } + closedir(DIR); + +} + +# ---------------------------------------- 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.= + '

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 + + my $thisdistarget=$target; + $thisdistarget=~s/^$docroot//; + + my $thissrc=$source; + $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/; + + my $thissrcdir=$thissrc; + $thissrcdir=~s/\/[^\/]+$/\//; + + + return $warning.$scrout. + '

View Target'. + '

Back to Source'. + '

Back to Source Directory'; + } # ================================================================ Main Handler @@ -56,39 +887,77 @@ sub handler { return OK; } +# Get query string for limited number of parameters + + map { + my ($name, $value) = split(/=/,$_); + $value =~ tr/+/ /; + $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; + if ($name eq 'filename') { + unless ($ENV{'form.'.$name}) { + $ENV{'form.'.$name}=$value; + } + } + } (split(/&/,$ENV{'QUERY_STRING'})); + + # -------------------------------------------------------------- Check filename my $fn=$ENV{'form.filename'}; + unless ($fn) { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + $r->log_reason($cuname.' at '.$cudom. ' trying to publish empty filename', $r->filename); return HTTP_NOT_FOUND; } - $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; + ($cuname,$cudom)= + &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); + unless (($cuname) && ($cudom)) { + $r->log_reason($cuname.' at '.$cudom. + ' trying to publish file '.$ENV{'form.filename'}. + ' ('.$fn.') - not authorized', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } + + unless (&Apache::lonnet::homeserver($cuname,$cudom) + eq $r->dir_config('lonHostID')) { + $r->log_reason($cuname.' at '.$cudom. + ' trying to publish file '.$ENV{'form.filename'}. + ' ('.$fn.') - not homeserver ('. + &Apache::lonnet::homeserver($cuname,$cudom).')', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } + + $fn=~s/^http\:\/\/[^\/]+//; + $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/; my $targetdir=''; - my $docroot=$r->dir_config('lonDocRoot'); - if ($1 ne $ENV{'user.name'}) { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + $docroot=$r->dir_config('lonDocRoot'); + if ($1 ne $cuname) { + $r->log_reason($cuname.' at '.$cudom. ' trying to publish unowned file '.$ENV{'form.filename'}. ' ('.$fn.')', $r->filename); return HTTP_NOT_ACCEPTABLE; } else { - $targetdir=$docroot.'/res/'.$ENV{'user.domain'}; + $targetdir=$docroot.'/res/'.$cudom; } unless (-e $fn) { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + $r->log_reason($cuname.' at '.$cudom. ' trying to publish non-existing file '.$ENV{'form.filename'}. ' ('.$fn.')', $r->filename); return HTTP_NOT_FOUND; } +unless ($ENV{'form.phase'} eq 'two') { + # --------------------------------- File is there and owned, init lookup tables %addid=(); @@ -99,13 +968,48 @@ sub handler { $addid{$1}=$2; } } + + %nokey=(); + + { + my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab'); + map { + my $word=$_; + chomp($word); + $nokey{$word}=1; + } <$fh>; + } + + %language=(); + + { + my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab'); + map { + $_=~/(\w+)\s+([\w\s\-]+)/; + $language{$1}=$2; + } <$fh>; + } + + %cprtag=(); + + { + my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab'); + map { + $_=~/(\w+)\s+([\w\s\-]+)/; + $cprtag{$1}=$2; + } <$fh>; + } + +} + # ----------------------------------------------------------- Start page output $r->content_type('text/html'); $r->send_http_header; $r->print('LON-CAPA Publishing'); - $r->print(''); + $r->print( + ''); my $thisfn=$fn; # ------------------------------------------------------------- Individual file @@ -123,18 +1027,34 @@ sub handler { $thisdistarget=~s/^$docroot//; my $thisdisfn=$thisfn; - $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///; + $thisdisfn=~s/^\/home\/$cuname\/public_html\///; $r->print('

Publishing '. &Apache::lonnet::filedescription($thistype).' '. $thisdisfn.'

Target: '.$thisdistarget.'

'); + + if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) { + $r->print('

Co-Author: '.$cuname.' at '.$cudom. + '

'); + } + if (&Apache::lonnet::fileembstyle($thistype) eq 'ssi') { + $r->print('
Diffs with Current Version

'); + } + # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle - $r->print('Result: '.&publish($thisfn,$thistarget,$thisembstyle)); - - } + unless ($ENV{'form.phase'} eq 'two') { + $r->print( + '

'.&publish($thisfn,$thistarget,$thisembstyle)); + } else { + $r->print( + '
'.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget)); + } + } $r->print(''); return OK;