Diff for /loncom/metadata_database/searchcat.pl between versions 1.28 and 1.30

version 1.28, 2003/02/03 05:39:37 version 1.30, 2003/02/03 17:01:55
Line 6 Line 6
 #  #
 # Copyright Michigan State University Board of Trustees  # Copyright Michigan State University Board of Trustees
 #  #
 # This file is part of the LearningOnline Network with a  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
 # Computer assisted personalized approach (loncapa).  
 #  #
 # Loncapa is free software; you can redistribute it and/or modify  # LON-CAPA is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by  # it under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 2 of the License, or  # the Free Software Foundation; either version 2 of the License, or
 # (at your option) any later version.  # (at your option) any later version.
 #  #
 # Loncapa is distributed in the hope that it will be useful,  # LON-CAPA is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of  # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.  # GNU General Public License for more details.
 #  #
 # You should have received a copy of the GNU General Public License  # You should have received a copy of the GNU General Public License
 # along with loncapa; if not, write to the Free Software  # along with LON-CAPA; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA  # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 #  #
 # /home/httpd/html/adm/gpl.txt  # /home/httpd/html/adm/gpl.txt
 #  #
 # http://www.loncapa.org/  # http://www.lon-capa.org/
 #  #
 # YEAR=2001  # YEAR=2001
 # 04/14/2001, 04/16/2001 Scott Harrison  # 04/14/2001, 04/16/2001 Scott Harrison
Line 375  sub escape ($) Line 374  sub escape ($)
   
 B<build_on_the_fly_dynamic_metadata> - evaluate and store dynamic metadata.  B<build_on_the_fly_dynamic_metadata> - evaluate and store dynamic metadata.
   
 Dynamic metadata is stored in a nohist_resevaldata GDBM database.  Returns the dynamic metadata for an author, which will later be added to the
 Most of the calculations in this subroutine are totally pointless  MySQL database (not yet implemented).
 and not useful for anything that this subroutine does.  
 (THIS IS A FRUSTRATED SUBROUTINE THAT IS NON-OPTIMAL, *&*&!.)  The vast majority of entries in F<nohist_resevaldata.db>, which contains
 The only thing that this subroutine really makes happen is adjusting  the dynamic metadata for an author's resources, are "count", which make
 a 'count' value inside the F<nohist_new_resevaldata.db> as well  the file really large and evaluation really slow.
 as updating F<nohist_new_resevaldata.db> with information from  
 F<nohist_resevaldata.db>.  While computing the current value of all dynamic metadata
   for later insertion into the MySQL metadata cache (not yet implemented),
   this routine also simply adds up all "count" type fields and replaces them by
   one new field with the to-date count.
   
   Only after successful completion of working with one author, copy new file to
   original file. Copy to tmp-"new"-db-file was necessary since db-file size 
   would not shrink after "delete" of key.
   
 =over 4  =over 4
   
Line 402  Returns: Line 408  Returns:
   
 =cut  =cut
   
 sub build_on_the_fly_dynamic_metadata ($)  sub build_on_the_fly_dynamic_metadata {
   {  
     # BEWARE ALL WHO TRY TO UNDERSTAND THIS ABSURDLY HORRIBLE SUBROUTINE.      # Need to compute the user's directory.
             my $url=&declutter(shift);
     # Do all sorts of mumbo-jumbo to compute the user's directory.      $url=~s/\.meta$//;
     my $url = &declutter(shift(@_));      my %returnhash=();
     $url =~ s/\.meta$//;      my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);
     my %returnhash = ();      my $user_directory=&construct_path_to_user_directory($adomain,$aauthor);
     my ($adomain,$aauthor) = ($url =~ m!^(\w+)/(\w+)/!);  
     my $user_directory = &construct_path_to_user_directory($adomain,$aauthor);  
   
     # Attempt a GDBM database instantiation inside users directory and proceed.      # Attempt a GDBM database instantiation inside users directory and proceed.
     if ((tie(%evaldata,'GDBM_File',      if ((tie(%evaldata,'GDBM_File',
Line 419  sub build_on_the_fly_dynamic_metadata ($ Line 423  sub build_on_the_fly_dynamic_metadata ($
      '/nohist_resevaldata.db',&GDBM_READER(),0640)) &&       '/nohist_resevaldata.db',&GDBM_READER(),0640)) &&
         (tie(%newevaldata,'GDBM_File',          (tie(%newevaldata,'GDBM_File',
      $user_directory.       $user_directory.
      '/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640)))       '/nohist_new_resevaldata.db',&GDBM_WRCREAT(),0640))) {
       {  
  # For different variables, track the running sum and counts.   # For different variables, track the running sum and counts.
  my %sum = ();   my %sum=();
  my %cnt = ();   my %cnt=();
   
  # Define computed items as a sum (add) or an average (avg) or a raw   # Define computed items as a sum (add) or an average (avg) or a raw
  # count (cnt) or 'app'?   # count (cnt) or append (app)?
  my %listitems=('count'        => 'add',   my %listitems=('count'        => 'add',
        'course'       => 'add',         'course'       => 'add',
        'avetries'     => 'avg',         'avetries'     => 'avg',
Line 442  sub build_on_the_fly_dynamic_metadata ($ Line 445  sub build_on_the_fly_dynamic_metadata ($
        );         );
   
  # Untaint the url and use as part of a regular expression.   # Untaint the url and use as part of a regular expression.
  my $regexp = $url;   my $regexp=$url;
  $regexp =~ s/(\W)/\\$1/g;   $regexp=~s/(\W)/\\$1/g;
  $regexp = '___'.$regexp.'___([a-z]+)$';   $regexp='___'.$regexp.'___([a-z]+)$'; #' emacs
   
  # Check existing nohist database for this url.   # Check existing database for this author.
  # THE ONLY TIME THIS IS IMPORTANT FOR THIS AWFUL SUBROUTINE          # this is modifying the 'count' entries
  # IS FOR 'count' ENTRIES          # and copying all other entries over
  # AND FOR REFRESHING non-'count' ENTRIES INSIDE nohist_new DATABASE.  
  foreach (keys %evaldata)   foreach (keys %evaldata) {
   {      my $key=&unescape($_);
     my $key = &unescape($_);      if ($key=~/$regexp/) { # If url-based entry exists.
     if ($key =~ /$regexp/) # If url-based entry exists.   my $ctype=$1; # Set to specific category type.
       {  
  my $ctype = $1; # Set to specific category type.  
   
  # Do an increment for this category type.   # Do an increment for this category type.
  if (defined($cnt{$ctype}))   if (defined($cnt{$ctype})) {
   {  
     $cnt{$ctype}++;       $cnt{$ctype}++; 
   }   } else {
  else      $cnt{$ctype}=1; 
   {   }
     $cnt{$ctype} = 1;                   unless ($listitems{$ctype} eq 'app') { # append comments
   }  
                 unless ($listitems{$ctype} eq 'app') # WHAT DOES 'app' MEAN?  
   {  
     # Increment the sum based on the evaluated data in the db.      # Increment the sum based on the evaluated data in the db.
     if (defined($sum{$ctype}))      if (defined($sum{$ctype})) {
       {   $sum{$ctype}+=$evaldata{$_};
  $sum{$ctype} += $evaldata{$_};      } else {
       }   $sum{$ctype}=$evaldata{$_};
     else      }
       {    } else { # 'app' mode, means to use '<hr />' as a separator
  $sum{$ctype} = $evaldata{$_};      if (defined($sum{$ctype})) {
       }   if ($evaldata{$_}) {
    }      $sum{$ctype}.='<hr />'.$evaldata{$_};
  else # 'app' mode, means to use '<hr />' as a separator   }
   {      } else {
     if (defined($sum{$ctype}))   $sum{$ctype}=''.$evaldata{$_};
       {      }
  if ($evaldata{$_})          }
   {   if ($ctype ne 'count') {
     $sum{$ctype} .= '<hr />'.$evaldata{$_};                      # this is copying all data except 'count' attributes
   }      $newevaldata{$_}=$evaldata{$_};
       }          }
     else      }
       {   }
  $sum{$ctype} = ''.$evaldata{$_};  
       }          # these values will be returned (currently still unused)
   }   foreach (keys %cnt) {
  if ($ctype ne 'count')      if ($listitems{$_} eq 'avg') {
   {   $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;
     # ALERT!  THIS HORRIBLE LOOP IS ACTUALLY DOING SOMETHING      } elsif ($listitems{$_} eq 'cnt') {
     # USEFUL!   $returnhash{$_}=$cnt{$_};
     $newevaldata{$_} = $evaldata{$_};      } else {
   }   $returnhash{$_}=$sum{$_};
       }      }
   }   }
   
  # THE ONLY OTHER TIME THIS LOOP IS USEFUL IS FOR THE 'count' HASH          # generate new count key in resevaldata, insert sum
  # ELEMENT.   if ($returnhash{'count'}) {
  foreach (keys %cnt)      my $newkey=$$.'_'.time.'_searchcat___'.&escape($url).'___count';
   {      $newevaldata{$newkey}=$returnhash{'count'};
     if ($listitems{$_} eq 'avg')   }
       {  
  $returnhash{$_} = int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;  
       }  
     elsif ($listitems{$_} eq 'cnt')  
       {  
  $returnhash{$_} = $cnt{$_};  
       }  
     else  
       {  
  $returnhash{$_} = $sum{$_};  
       }  
   }  
   
  # A RARE MOMENT OF DOING ANYTHING USEFUL INSIDE THIS  
  # BLEEPING SUBROUTINE.  
  if ($returnhash{'count'})  
   {  
     my $newkey = $$.'_'.time.'_searchcat___'.&escape($url).'___count';  
     $newevaldata{$newkey} = $returnhash{'count'};  
   }  
   
  untie(%evaldata); # Close/release the original nohist database.   untie(%evaldata); # Close/release the original nohist database.
  untie(%newevaldata); # Close/release the new nohist database.   untie(%newevaldata); # Close/release the new nohist database.
       }      }
     return(%returnhash);      return %returnhash;
     # Celebrate!  We have now accomplished some simple calculations using  }
     # 1000% bloated functionality in our subroutine.  Go wash your eyeballs  
     # out now.  
   }  
   
 =pod  =pod
   

Removed from v.1.28  
changed lines
  Added in v.1.30


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