--- loncom/publisher/lonpublisher.pm 2007/02/21 21:01:59 1.220 +++ loncom/publisher/lonpublisher.pm 2007/07/13 19:23:33 1.226 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.220 2007/02/21 21:01:59 albertel Exp $ +# $Id: lonpublisher.pm,v 1.226 2007/07/13 19:23:33 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -409,15 +409,14 @@ sub urlfixup { if ($url =~ /^mailto:/i) { return $url; } #internal document links need no fixing if ($url =~ /^\#/) { return $url; } - my ($host)=($url=~/(?:(?:http|https|ftp)\:\/\/)*([^\/]+)/); - foreach (values %Apache::lonnet::hostname) { - if ($_ eq $host) { - $url=~s/^(?:http|https|ftp)\:\/\///; - $url=~s/^$host//; - } + my ($host)=($url=~m{(?:(?:http|https|ftp)://)*([^/]+)}); + my @lonids = &Apache::lonnet::machine_ids($host); + if (@lonids) { + $url=~s{^(?:http|https|ftp)://}{}; + $url=~s/^\Q$host\E//; } - if ($url=~/^(?:http|https|ftp)\:\/\//) { return $url; } - $url=~s/\~$cuname/res\/$cudom\/$cuname/; + if ($url=~m{^(?:http|https|ftp)://}) { return $url; } + $url=~s{\Q~$cuname\E}{res/$cudom/$cuname}; return $url; } @@ -495,11 +494,15 @@ sub get_subscribed_hosts { $target=~/(.*)\/([^\/]+)$/; my $srcf=$2; opendir(DIR,$1); + # cycle through listed files, subscriptions used to exist + # as "filename.lonid" while ($filename=readdir(DIR)) { if ($filename=~/\Q$srcf\E\.($match_lonid)$/) { my $subhost=$1; - if (($subhost ne 'meta' && $subhost ne 'subscription' && - $subhost ne 'tmp') && + if (($subhost ne 'meta' + && $subhost ne 'subscription' + && $subhost ne 'meta.subscription' + && $subhost ne 'tmp') && ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) { push(@subscribed,$subhost); } @@ -651,7 +654,7 @@ sub fix_ids_and_indices { join(', ',@duplicatedids)); if ($duplicateids) { print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n"; - my $outstring=''.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).''; + my $outstring=''.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).''; return ($outstring,1); } if ($needsfixup) { @@ -822,15 +825,15 @@ sub store_metadata { # Determine if the table exists my $status = &Apache::lonmysql::check_table('metadata'); if (! defined($status)) { - $error='WARNING: Cannot connect to '. - 'database!'; + $error='WARNING: Cannot connect to '. + 'database!'; &Apache::lonnet::logthis($error); return ($error,undef); } if ($status == 0) { # It would be nice to actually create the table.... - $error ='WARNING: The metadata table does not '. - 'exist in the LON-CAPA database.'; + $error ='WARNING: The metadata table does not '. + 'exist in the LON-CAPA database.'; &Apache::lonnet::logthis($error); return ($error,undef); } @@ -845,8 +848,8 @@ sub store_metadata { \%metadata); } if (defined($status) && $status ne '') { - $error='Error occured storing new values in '. - 'metadata table in LON-CAPA database'; + $error='Error occured saving new values in '. + 'metadata table in LON-CAPA database'; &Apache::lonnet::logthis($error); &Apache::lonnet::logthis($status); return ($error,undef); @@ -868,9 +871,9 @@ sub checkonthis { if (($errorcount) || ($warningcount)) { $r->print('
'.$uri.': '); if ($errorcount) { - $r->print(''. + $r->print(''. $errorcount.' '. - &mt('error(s)').' '); + &mt('error(s)').' '); } if ($warningcount) { $r->print(''. @@ -934,7 +937,7 @@ sub publish { my %allow=(); unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - return (''.&mt('No write permission to user directory, FAIL').'',1); + return (''.&mt('No write permission to user directory, FAIL').'',1); } print $logfile "\n\n================= Publish ".localtime()." Phase One ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n"; @@ -948,7 +951,7 @@ sub publish { print $logfile "Copied original file to ".$copyfile."\n"; } else { print $logfile "Unable to write backup ".$copyfile.':'.$!."\n"; - return ("Failed to write backup copy, $!,FAIL",1); + return ("Failed to write backup copy, $!,FAIL",1); } # ------------------------------------------------------------- IDs and indices @@ -976,8 +979,8 @@ sub publish { if ( &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'. $thisdep.'.meta') eq '-1') { - $scrout.= ' - '.&mt('Currently not available'). - ''; + $scrout.= ' - '.&mt('Currently not available'). + ''; } else { my %temphash=(&Apache::lonnet::declutter($target).'___'. &Apache::lonnet::declutter($thisdep).'___usage' @@ -998,9 +1001,9 @@ sub publish { my $org; unless ($org=Apache::File->new('>'.$source)) { print $logfile "No write permit to $source\n"; - return (''.&mt('No write permission to'). + return (''.&mt('No write permission to'). ' '.$source. - ', '.&mt('FAIL').'',1); + ', '.&mt('FAIL').'',1); } print($org $outstring); } @@ -1105,7 +1108,7 @@ sub publish { } } if ($chparms) { - $scrout.='

'.&mt('New parameters or stored values'). + $scrout.='

'.&mt('New parameters or saved values'). ': '.$chparms.'

'; } @@ -1122,7 +1125,7 @@ sub publish { } } if ($chparms) { - $scrout.='

'.&mt('Obsolete parameters or stored values').': '. + $scrout.='

'.&mt('Obsolete parameters or saved values').': '. $chparms.'

'.&mt('Warning!'). '

'. &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'

'; @@ -1411,17 +1414,17 @@ sub phasetwo { # unless ($env{'form.obsolete'}) { if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) { - $r->print( - ''.&mt('Unsupported character combination'). - ' "'.$1.'" '.&mt('in filename, FAIL').''); + $r->print(''. + &mt('Unsupported character combination [_1] in filename, FAIL.',"'.$1.'"). + ''); return 0; } unless ($target=~/\.(\w+)$/) { - $r->print(''.&mt('No valid extension found in filename, FAIL').''); + $r->print(''.&mt('No valid extension found in filename, FAIL').''); return 0; } if ($target=~/\.(\d+)\.(\w+)$/) { - $r->print(''.&mt('Cannot publish versioned resource, FAIL').''); + $r->print(''.&mt('Cannot publish versioned resource, FAIL').''); return 0; } } @@ -1433,8 +1436,8 @@ sub phasetwo { my $logfile; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { $r->print( - ''. - &mt('No write permission to user directory, FAIL').''); + ''. + &mt('No write permission to user directory, FAIL').''); return 0; } print $logfile @@ -1491,8 +1494,8 @@ sub phasetwo { my $file=$metadatafields{'customdistributionfile'}; unless ($file=~/\.rights$/) { $r->print( - ''.&mt('No valid custom distribution rights file specified, FAIL'). - ''); + ''.&mt('No valid custom distribution rights file specified, FAIL'). + ''); return 0; } } @@ -1501,8 +1504,8 @@ sub phasetwo { my $mfh; unless ($mfh=Apache::File->new('>'.$source.'.meta')) { $r->print( - ''.&mt('Could not write metadata, FAIL'). - ''); + ''.&mt('Could not write metadata, FAIL'). + ''); return 0; } foreach (sort keys %metadatafields) { @@ -1555,7 +1558,7 @@ sub phasetwo { unless ($srcd=~/^\/home\/httpd\/html\/res/) { print $logfile "\nPANIC: Target dir is ".$srcd; $r->print( - "Invalid target directory, FAIL"); + "Invalid target directory, FAIL"); return 0; } opendir(DIR,$srcd); @@ -1581,8 +1584,8 @@ sub phasetwo { $r->print('

'.&mt('Copied old target file').'

'); } else { print $logfile "Unable to write ".$copyfile.':'.$!."\n"; - $r->print("".&mt('Failed to copy old target'). - ", $!, ".&mt('FAIL').""); + $r->print("".&mt('Failed to copy old target'). + ", $!, ".&mt('FAIL').""); return 0; } @@ -1597,8 +1600,8 @@ sub phasetwo { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; if (-e $target.'.meta') { $r->print( - "". -&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL').""); + "". +&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL').""); return 0; } } @@ -1630,8 +1633,8 @@ sub phasetwo { $r->print('

'.&mt('Copied source file').'

'); } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; - $r->print("". - &mt('Failed to copy source').", $!, ".&mt('FAIL').""); + $r->print("". + &mt('Failed to copy source').", $!, ".&mt('FAIL').""); return 0; } @@ -1645,7 +1648,7 @@ sub phasetwo { } else { print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; $r->print( - "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL').""); + "".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL').""); return 0; } $r->rflush; @@ -1878,8 +1881,8 @@ sub defaultmetapublish { if (copy($fn,$copyfile)) { $r->print('

'.&mt('Copied source file').'

'); } else { - return "". - &mt('Failed to copy source').", $!, ".&mt('FAIL').""; + return "". + &mt('Failed to copy source').", $!, ".&mt('FAIL').""; } # --------------------------------------------------- Send update notifications