--- loncom/publisher/lonpublisher.pm 2000/12/02 20:55:16 1.11 +++ loncom/publisher/lonpublisher.pm 2001/05/28 19:43:47 1.30 @@ -5,17 +5,24 @@ # # 05/29/00,05/30,10/11 Gerd Kortemeyer) # -# 11/28,11/29,11/30,12/01,12/02 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 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::structuretags; -use Apache::response; +use Apache::lonhomework; +use Apache::loncacc; +use DBI; my %addid; my %nokey; @@ -25,6 +32,13 @@ my %cprtag; my %metadatafields; my %metadatakeys; +my $docroot; + +my $cuname; +my $cudom; + +# ----------------------------------------------- Evaluate string with metadata + sub metaeval { my $metastring=shift; @@ -60,6 +74,8 @@ sub metaeval { } } +# -------------------------------------------------------- Read a metadata file + sub metaread { my ($logfile,$fn)=@_; unless (-e $fn) { @@ -76,6 +92,16 @@ sub metaread { 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:
". @@ -98,11 +124,15 @@ sub selectbox { return $selout.''; } +# -------------------------------------------------------- Publication Step One + sub publish { my ($source,$target,$style)=@_; my $logfile; my $scrout=''; + my $allmeta=''; + my $content=''; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { return @@ -116,22 +146,17 @@ sub publish { # ----------------------------------------------------------------- Backup Copy my $copyfile=$source.'.save'; - { - my $org=Apache::File->new($source); - my $cop=Apache::File->new('>'.$copyfile); - while (my $line=<$org>) { print $cop $line; } - } - if (-e $copyfile) { + 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"; + 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 $content=''; + my $needsfixup=0; { @@ -242,17 +267,17 @@ sub publish { $ENV{'environment.generation'}; $metadatafields{'author'}=~s/\s+/ /g; $metadatafields{'author'}=~s/\s+$//; - $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'}; + $metadatafields{'owner'}=$cuname.'@'.$cudom; # ------------------------------------------------ Check out directory hierachy my $thisdisfn=$source; - $thisdisfn=~s/^\/home\/$ENV{'user.name'}\///; + $thisdisfn=~s/^\/home\/$cuname\///; my @urlparts=split(/\//,$thisdisfn); $#urlparts--; - my $currentpath='/home/'.$ENV{'user.name'}.'/'; + my $currentpath='/home/'.$cuname.'/'; map { $currentpath.=$_.'/'; @@ -283,7 +308,7 @@ sub publish { # -------------------------------------------------- Parse content for metadata - my $allmeta=Apache::lonxml::xmlparse('meta',$content); + $allmeta=Apache::lonxml::xmlparse('meta',$content); &metaeval($allmeta); # ---------------- Find and document discrepancies in the parameters and stores @@ -307,7 +332,7 @@ sub publish { my $chparms=''; map { if (($_=~/^parameter/) || ($_=~/^stores/)) { - unless (($metadatafields{$_}) || ($_=~/\.\w+$/)) { + unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) { print $logfile 'Obsolete: '.$_."\n"; $chparms.=$_.' '; } @@ -317,7 +342,7 @@ sub publish { $scrout.='

Obsolete parameters or stored values: '. $chparms; } - + } # ------------------------------------------------------- Now have all metadata $scrout.= @@ -350,9 +375,12 @@ sub publish { } } ($textonly=~m/(\w+)/g); + map { + $keywords{$_}=1; + } split(/\W+/,$metadatafields{'keywords'}); map { - $keywordout.=''; } +# -------------------------------------------------------- Publication Step Two + sub phasetwo { - my ($source,$target,$style)=@_; + my ($source,$target,$style,$distarget)=@_; my $logfile; my $scrout=''; @@ -422,7 +453,6 @@ sub phasetwo { $metadatafields{'title'}=$ENV{'form.title'}; $metadatafields{'author'}=$ENV{'form.author'}; $metadatafields{'subject'}=$ENV{'form.subject'}; - $metadatafields{'keywords'}=$ENV{'form.keywords'}; $metadatafields{'notes'}=$ENV{'form.notes'}; $metadatafields{'abstract'}=$ENV{'form.abstract'}; $metadatafields{'mime'}=$ENV{'form.mime'}; @@ -431,12 +461,268 @@ sub phasetwo { $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'}; $metadatafields{'owner'}=$ENV{'form.owner'}; $metadatafields{'copyright'}=$ENV{'form.copyright'}; - + + my $allkeywords=$ENV{'form.addkey'}; map { - print $logfile "\n".$_.': '.$metadatafields{$_}. - "\n".$_.'.keys: '.$metadatakeys{$_}; - } sort keys %metadatafields; + 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; + } + } + 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 + +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'; } @@ -455,16 +741,28 @@ sub handler { 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; } - unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) { - $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + unless (($cuname,$cudom)= + &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'))) { + $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 ('.$ENV{'user.home'}.')', + ' ('.$fn.') - not homeserver ('. + &Apache::lonnet::homeserver($cuname,$cudom).')', $r->filename); return HTTP_NOT_ACCEPTABLE; } @@ -472,20 +770,20 @@ sub handler { $fn=~s/^http\:\/\/[^\/]+\/\~(\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); @@ -544,7 +842,8 @@ unless ($ENV{'form.phase'} eq 'two') { $r->send_http_header; $r->print('LON-CAPA Publishing'); - $r->print(''); + $r->print( + ''); my $thisfn=$fn; # ------------------------------------------------------------- Individual file @@ -562,18 +861,31 @@ unless ($ENV{'form.phase'} eq 'two') { $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 unless ($ENV{'form.phase'} eq 'two') { - $r->print('

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