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;
+ }
+ }
}
- return $scrout;
+ 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.
+ '
');
my $thisfn=$fn;
# ------------------------------------------------------------- Individual file
@@ -275,18 +861,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('