Diff for /loncom/lond between versions 1.178.2.19 and 1.178.2.20

version 1.178.2.19, 2004/04/26 10:37:47 version 1.178.2.20, 2004/04/27 11:30:28
Line 1028  sub UpdateResourceHandler { Line 1028  sub UpdateResourceHandler {
         
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
         
     my $fname=$tail;      my $fname=split(/:/$tail); # This allows interactive testing
       chomp($fname); # with telnet.
   
     my $ownership=ishome($fname);      my $ownership=ishome($fname);
     if ($ownership eq 'not_owner') {      if ($ownership eq 'not_owner') {
  if (-e $fname) {   if (-e $fname) {
Line 1188  sub UnsubscribeHandler { Line 1190  sub UnsubscribeHandler {
     my $client   = shift;      my $client   = shift;
     my $userinput= "$cmd:$tail";      my $userinput= "$cmd:$tail";
           
     my $fname = $tail;      my ($fname) = split(/:/,$tail); # This allows for interactive testing
                                       # e.g. manual telnet and unsub:res:
                                       # Otherwise the \r gets in the way. 
       chomp($fname);
       Debug("Unsubscribing $fname");
     if (-e $fname) {      if (-e $fname) {
  Reply($client, &unsub($client,$fname,$clientip), $userinput);   Debug("Exists");
    Reply($client, &unsub($fname,$clientip), $userinput);
     } else {      } else {
  Failure($client, "not_found\n", $userinput);   Failure($client, "not_found\n", $userinput);
     }      }
     return 1;      return 1;
 }  }
 RegisterHandler("unusb", \&UnsubscribeHandler, 0, 1, 0);  RegisterHandler("unsub", \&UnsubscribeHandler, 0, 1, 0);
   
 #   Subscribe to a resource  #   Subscribe to a resource
 #  #
Line 3818  sub propath { Line 3825  sub propath {
   
 sub ishome {  sub ishome {
     my $author=shift;      my $author=shift;
       Debug("ishome: $author");
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
       Debug("     after big regsub: $author");
     my ($udom,$uname)=split(/\//,$author);      my ($udom,$uname)=split(/\//,$author);
       Debug("      domain: $udom  user: $uname");
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
       Debug("     path = $proname");
     if (-e $proname) {      if (-e $proname) {
  return 'owner';   return 'owner';
     } else {      } else {
Line 4286  sub addline { Line 4297  sub addline {
     my $expr='^'.$hostid.':'.$ip.':';      my $expr='^'.$hostid.':'.$ip.':';
     $expr =~ s/\./\\\./g;      $expr =~ s/\./\\\./g;
     my $sh;      my $sh;
       Debug("Looking for $expr");
     if ($sh=IO::File->new("$fname.subscription")) {      if ($sh=IO::File->new("$fname.subscription")) {
  while (my $subline=<$sh>) {   while (my $subline=<$sh>) {
     if ($subline !~ /$expr/) {$contents.= $subline;} else {$found=1;}      Debug("addline: line: $subline");
       if ($subline !~ /$expr/) {
    $contents.= $subline;
       } else {
    Debug("Found $subline");
    $found=1;
       }
  }   }
  $sh->close();   $sh->close();
     }      }
     $sh=IO::File->new(">$fname.subscription");      $sh=IO::File->new(">$fname.subscription");
     if ($contents) { print $sh $contents; }      if ($contents) { print $sh $contents; }
     if ($newline) { print $sh $newline; }      if ($newline) { 
    Debug("Appending $newline");
    print $sh $newline; 
       }
     $sh->close();      $sh->close();
     return $found;      return $found;
 }  }
Line 4367  sub chatadd { Line 4388  sub chatadd {
 sub unsub {  sub unsub {
     my ($fname,$clientip)=@_;      my ($fname,$clientip)=@_;
     my $result;      my $result;
     if (unlink("$fname.$clientname")) {  #    if (unlink("$fname.$clientname")) {
  $result="ok\n";  # $result="ok\n";
     } else {  #    } else {
  $result="not_subscribed\n";  # $result="not_subscribed\n";
     }  #    }
       unlink("$fname.$clientname");
     if (-e "$fname.subscription") {      if (-e "$fname.subscription") {
    Debug ("Processing subscription file $fname.subscription");
  my $found=&addline($fname,$clientname,$clientip,'');   my $found=&addline($fname,$clientname,$clientip,'');
  if ($found) { $result="ok\n"; }   if ($found) { 
       Debug("Old linek found");
       $result="ok\n"; 
    } else {
       $result = "not_subscribed\n";
    }
     } else {      } else {
  if ($result != "ok\n") { $result="not_subscribed\n"; }   Debug("No Subscription file $fname.subscription");
    if ($result ne "ok\n") { $result="not_subscribed\n"; }
     }      }
     return $result;      return $result;
 }  }
Line 4429  sub thisversion { Line 4458  sub thisversion {
   
 sub subscribe {  sub subscribe {
     my ($userinput,$clientip)=@_;      my ($userinput,$clientip)=@_;
       chomp($userinput);
     my $result;      my $result;
     my ($cmd,$fname)=split(/:/,$userinput);      my ($cmd,$fname)=split(/:/,$userinput);
     my $ownership=&ishome($fname);      my $ownership=&ishome($fname);
       Debug("subscribe: Owner = $ownership file: '$fname'");
     if ($ownership eq 'owner') {      if ($ownership eq 'owner') {
 # explitly asking for the current version?  # explitly asking for the current version?
         unless (-e $fname) {          unless (-e $fname) {
       Debug("subscribe - does not exist");
             my $currentversion=&currentversion($fname);              my $currentversion=&currentversion($fname);
     if (&thisversion($fname)==$currentversion) {      if (&thisversion($fname)==$currentversion) {
                 if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) {                  if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) {
Line 4450  sub subscribe { Line 4482  sub subscribe {
             }              }
         }          }
  if (-e $fname) {   if (-e $fname) {
       Debug("subscribe - exists");
     if (-d $fname) {      if (-d $fname) {
  $result="directory\n";   $result="directory\n";
     } else {      } else {

Removed from v.1.178.2.19  
changed lines
  Added in v.1.178.2.20


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>