Diff for /loncom/metadata_database/LONCAPA/lonmetadata.pm between versions 1.14 and 1.17

version 1.14, 2006/09/26 15:15:31 version 1.17, 2007/01/12 21:30:58
Line 30  package LONCAPA::lonmetadata; Line 30  package LONCAPA::lonmetadata;
   
 use strict;  use strict;
 use DBI;  use DBI;
   use HTML::TokeParser;
 use vars qw($Metadata_Table_Description $Portfolio_metadata_table_description   use vars qw($Metadata_Table_Description $Portfolio_metadata_table_description 
 $Portfolio_access_table_description $Fulltext_indicies $Portfolio_metadata_indices $Portfolio_access_indices $Portfolio_addedfields_table_description $Portfolio_addedfields_indices);  $Portfolio_access_table_description $Fulltext_indicies $Portfolio_metadata_indices $Portfolio_access_indices $Portfolio_addedfields_table_description $Portfolio_addedfields_indices);
   
Line 502  sub lookup_metadata { Line 503  sub lookup_metadata {
                 $error = $sth->errstr;                  $error = $sth->errstr;
             }              }
         }          }
     }      } 
     return ($error,$returnvalue);      return ($error,$returnvalue);
 }  }
   
Line 928  sub dynamic_metadata_storage { Line 929  sub dynamic_metadata_storage {
     return %Store;      return %Store;
 }  }
   
   ###############################################################
   ###############################################################
   ###                                                         ###
   ###  &portfolio_metadata($filepath,$dom,$uname,$group)      ###
   ###   Retrieve metadata for the given file                  ###
   ###   Returns array -                                       ###
   ###      contains reference to metadatahash and             ###
   ###         optional reference to addedfields hash          ###
   ###                                                         ###
   ###############################################################
   ###############################################################
   
   sub portfolio_metadata {
       my ($fullpath,$dom,$uname,$group)=@_;
       my ($mime) = ( $fullpath=~/\.(\w+)$/ );
       my %metacache=();
       if ($fullpath !~ /\.meta$/) {
           $fullpath .= '.meta';
       }
       my (@standard_fields,%addedfields);
       my $colsref = $Portfolio_metadata_table_description;
       if (ref($colsref) eq 'ARRAY') {
           my @columns = @{$colsref};
           foreach my $coldata (@columns) {
               push(@standard_fields,$coldata->{'name'});
           }
       }
       my $metastring=&getfile($fullpath);
       if (! defined($metastring)) {
           $metacache{'keys'}= 'owner,domain,mime';
           $metacache{'owner'} = $uname.':'.$dom;
           $metacache{'domain'} = $dom;
           $metacache{'mime'} = $mime;
           if ($group ne '') {
               $metacache{'keys'} .= ',courserestricted';
               $metacache{'courserestricted'} = 'course.'.$dom.'_'.$uname;
           }
       } else {
           my $parser=HTML::TokeParser->new(\$metastring);
           my $token;
           while ($token=$parser->get_token) {
               if ($token->[0] eq 'S') {
                   my $entry=$token->[1];
                   if ($metacache{'keys'}) {
                       $metacache{'keys'}.=','.$entry;
                   } else {
                       $metacache{'keys'}=$entry;
                   }
                   my $value = $parser->get_text('/'.$entry);
                   if (!grep(/^\Q$entry\E$/,@standard_fields)) {
                       my $clean_value = lc($value);
                       $clean_value =~ s/\s/_/g;
                       if ($clean_value ne $entry) {
                           if (defined($addedfields{$entry})) {
                               $addedfields{$entry} .=','.$value;
                           } else {
                               $addedfields{$entry} = $value;
                           }
                       }
                   } else {
                       $metacache{$entry} = $value;
                   }
               }
           } # End of ($token->[0] eq 'S')
       }
       if (keys(%addedfields) > 0) {
           foreach my $key (sort keys(%addedfields)) {
               $metacache{'addedfieldnames'} .= $key.',';
               $metacache{'addedfieldvalues'} .= $addedfields{$key}.'&&&';
           }
           $metacache{'addedfieldnames'} =~ s/,$//;
           $metacache{'addedfieldvalues'} =~ s/\&\&\&$//;
           if ($metacache{'keys'}) {
               $metacache{'keys'}.=',addedfieldnames';
           } else {
               $metacache{'keys'}='addedfieldnames';
           }
           $metacache{'keys'}.=',addedfieldvalues';
       }
       return (\%metacache,$metacache{'courserestricted'},\%addedfields);
   }
   
   sub process_portfolio_access_data {
       my ($dbh,$simulate,$newnames,$url,$fullpath,$access_hash,$caller) = @_;
       my %loghash;
       if ($caller eq 'update') {
           # Delete old data (no error if deleting non-existent record).
           my $error=&delete_metadata($dbh,$newnames->{'access'},$url);
           if (defined($error)) {
               $loghash{'access'}{'err'} = "MySQL Error Delete: ".$error;
               return %loghash;
           }
       }
       # Check the file exists
       if (-e $fullpath) {
           foreach my $key (keys(%{$access_hash})) {
               my $acc_data;
               $acc_data->{url} = $url;
               $acc_data->{keynum} = $key;
               my ($num,$scope,$end,$start) =
                               ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
               next if (($scope ne 'public') && ($scope ne 'guest'));
               $acc_data->{scope} = $scope;
               if ($end != 0) {
                   $acc_data->{end} = &sqltime($end);
               }
               $acc_data->{start} = &sqltime($start);
               if (! $simulate) {
                   my ($count,$err) =
                        &store_metadata($dbh,$newnames->{'access'},
                                        'portfolio_access',$acc_data);
                   if ($err) {
                       $loghash{$key}{'err'} = "MySQL Error Insert: ".$err;
                   }
                   if ($count < 1) {
                       $loghash{$key}{'count'} = 
                           "Unable to insert record into MySQL database for $url";
                   }
               }
           }
       }
       return %loghash;
   }
   
   sub process_portfolio_metadata {
       my ($dbh,$simulate,$newnames,$url,$fullpath,$is_course,$dom,$uname,$group,$caller) = @_;
       my %loghash;
       if ($caller eq 'update') {
           # Delete old data (no error if deleting non-existent record).
           my $error=&delete_metadata($dbh,$newnames->{'portfolio'},$url);
           if (defined($error)) {
               $loghash{'metadata'}{'err'} = "MySQL Error delete metadata: ".
                                                  $error;
               return %loghash;
           }
           $error=&delete_metadata($dbh,$newnames->{'addedfields'},$url);
           if (defined($error)) {
               $loghash{'addedfields'}{'err'}="MySQL Error delete addedfields: ".$error;
           }
       }
       # Check the file exists.
       if (-e $fullpath) {
           my ($ref,$crs,$addedfields) = &portfolio_metadata($fullpath,$dom,$uname,
                                                             $group);
           &getfiledates($ref,$fullpath);
           if ($is_course) {
               $ref->{'groupname'} = $group;
           }
           my %Data;
           if (ref($ref) eq 'HASH') {
               %Data = %{$ref};
           }
           %Data = (
                    %Data,
                    'url'=>$url,
                    'version'=>'current',
           );
           my %loghash;
           if (! $simulate) {
               my ($count,$err) =
               &store_metadata($dbh,$newnames->{'portfolio'},'portfolio_metadata',
                               \%Data);
               if ($err) {
                   $loghash{'metadata'."\0"}{'err'} = "MySQL Error Insert: ".$err;
               }
               if ($count < 1) {
                   $loghash{'metadata'."\0"}{'count'} = "Unable to insert record into MySQL portfolio_metadata database table for $url";
               }
               if (ref($addedfields) eq 'HASH') {
                   if (keys(%{$addedfields}) > 0) {
                       foreach my $key (keys(%{$addedfields})) {
                           my $added_data = {
                                       'url'   => $url,
                                       'field' => $key,
                                       'value' => $addedfields->{$key},
                                       'courserestricted' => $crs,
                           };
                           my ($count,$err) = 
                               &store_metadata($dbh,$newnames->{'addedfields'},
                                      'portfolio_addedfields',$added_data);
                           if ($err) {
                               $loghash{$key}{'err'} = 
                                   "MySQL Error Insert: ".$err;
                           }
                           if ($count < 1) {
                               $loghash{$key}{'count'} = "Unable to insert record into MySQL portfolio_addedfields database table for url = $url and field = $key";
                           }
                       }
                   }
               }
           }
       }
       return %loghash;
   }
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
   
   ## Utilities originally in searchcat.pl.  Moved to be more widely available.
   
   sub getfile {
       my $file = shift();
       if (! -e $file ) { 
           return undef; 
       }
       open(my $fh,"<$file");
       my $contents = '';
       while (<$fh>) { 
           $contents .= $_;
       }
       return $contents;
   }
   
   ##
   ## &getfiledates()
   ## Converts creationdate and modifieddates to SQL format
   ## Applies stat() to file to retrieve dates if missing
   sub getfiledates {
       my ($ref,$target) = @_;
       if (! defined($ref->{'creationdate'}) ||
           $ref->{'creationdate'} =~ /^\s*$/) {
           $ref->{'creationdate'} = (stat($target))[9];
       }
       if (! defined($ref->{'lastrevisiondate'}) ||
           $ref->{'lastrevisiondate'} =~ /^\s*$/) {
           $ref->{'lastrevisiondate'} = (stat($target))[9];
       }
       $ref->{'creationdate'}     = &sqltime($ref->{'creationdate'});
       $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'});
   }
    
   ##
   ## &sqltime($timestamp)
   ##
   ## Convert perl $timestamp to MySQL time.  MySQL expects YYYY-MM-DD HH:MM:SS
   ##
   sub sqltime {
       my ($time) = @_;
       my $mysqltime;
       if ($time =~
           /(\d+)-(\d+)-(\d+) # YYYY-MM-DD
           \s                 # a space
           (\d+):(\d+):(\d+)  # HH:MM::SS
           /x ) {
           # Some of the .meta files have the time in mysql
           # format already, so just make sure they are 0 padded and
           # pass them back.
           $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
                                $1,$2,$3,$4,$5,$6);
       } elsif ($time =~ /^\d+$/) {
           my @TimeData = gmtime($time);
           # Alter the month to be 1-12 instead of 0-11
           $TimeData[4]++;
           # Alter the year to be from 0 instead of from 1900
           $TimeData[5]+=1900;
           $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
                                @TimeData[5,4,3,2,1,0]);
       } elsif (! defined($time) || $time == 0) {
           $mysqltime = 0;
       } else {
           &log(0,"    sqltime:Unable to decode time ".$time);
           $mysqltime = 0;
       }
       return $mysqltime;
   }
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################

Removed from v.1.14  
changed lines
  Added in v.1.17


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