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;
+ }
+ }
}
- return $scrout;
+ 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.
+ '
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.
');
my $thisfn=$fn;
# ------------------------------------------------------------- Individual file
@@ -237,18 +962,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('