[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.99 and 1.101

version 1.99, 2002/09/20 02:04:07 version 1.101, 2002/10/03 15:02:22
Line 1224  sub make_new_child { Line 1224  sub make_new_child {
        } else {         } else {
                           $regexp='.';                            $regexp='.';
        }         }
                        my $proname=propath($udom,$uname);  
                        my $qresult='';                         my $qresult='';
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {                         my $proname=propath($udom,$uname);
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
                            study($regexp);                             study($regexp);
                            foreach $key (keys %hash) {                             while (($key,$value) = each(%hash)) {
                                my $unescapeKey = &unescape($key);                                 if ($regexp eq '.') {
                                if (eval('$unescapeKey=~/$regexp/')) {                                     $qresult.=$key.'='.$value.'&';
                                   $qresult.="$key=$hash{$key}&";                                 } else {
                               }                                     my $unescapeKey = &unescape($key);
                                      if (eval('$unescapeKey=~/$regexp/')) {
                                          $qresult.="$key=$value&";
                                      }
                                  }
                            }                             }
    if (untie(%hash)) {                             if (untie(%hash)) {
               $qresult=~s/\&$//;                                 chop($qresult);
                               print $client "$qresult\n";                                 print $client "$qresult\n";
                            } else {                             } else {
                               print $client "error:$!\n";                                 print $client "error:$!\n";
                            }                             }
                        } else {                         } else {
                            print $client "error:$!\n";                             print $client "error:$!\n";
Line 1643  sub unsub { Line 1647  sub unsub {
     return $result;      return $result;
 }  }
   
   sub currentversion {
       my $fname=shift;
       my $version=-1;
       my $ulsdir='';
       if ($fname=~/^(.+)\/[^\/]+$/) {
          $ulsdir=$1;
       }
       $fname=~s/\.\d+\.(\w+(?:\.meta)*)$/\.$1/;
       $fname=~s/\.(\w+)$/\.\(\\d\+\)\.$1\$/;
       if (-e $fname) { $version=1; }
       if (-e $ulsdir) {
          if(-d $ulsdir) {
             if (opendir(LSDIR,$ulsdir)) {
                while ($ulsfn=readdir(LSDIR)) {
   # see if this is a regular file (ignore links produced earlier)
                    my $thisfile=$ulsdir.'/'.$ulsfn;
                    unless (-l $thisfile) {
       if ($thisfile=~/$fname/) {
           if ($1>$version) { $version=$1; }
                       }
    }
                }
                closedir(LSDIR);
                $version++;
             }
         }
      }
      return $version;
   }
   
   sub thisversion {
       my $fname=shift;
       my $version=-1;
       if ($fname=~/\.(\d+)\.\w+(?:\.meta)*$/) {
    $version=$1;
       }
       return $version;
   }
   
 sub subscribe {  sub subscribe {
     my ($userinput,$clientip)=@_;      my ($userinput,$clientip)=@_;
     my $result;      my $result;
     my ($cmd,$fname)=split(/:/,$userinput);      my ($cmd,$fname)=split(/:/,$userinput);
     my $ownership=&ishome($fname);      my $ownership=&ishome($fname);
     if ($ownership eq 'owner') {      if ($ownership eq 'owner') {
   # explitly asking for the current version?
           unless (-e $fname) {
               my $currentversion=&currentversion($fname);
       if (&thisversion($fname)==$currentversion) {
                   if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) {
       my $root=$1;
                       my $extension=$2;
                       symlink($root.'.'.$extension,
                               $root.'.'.$currentversion.'.'.$extension);
                   }
               }
           }
  if (-e $fname) {   if (-e $fname) {
     if (-d $fname) {      if (-d $fname) {
  $result="directory\n";   $result="directory\n";
Removed from v.1.99  
changed lines
  Added in v.1.101

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