File:  [LON-CAPA] / loncom / metadata_database / LONCAPA / lonmetadata.pm
Revision 1.17: download - view: text, annotated - select for diffs
Fri Jan 12 21:30:58 2007 UTC (17 years, 5 months ago) by albertel
Branches: MAIN
CVS tags: version_2_3_X, version_2_3_2, version_2_3_1, HEAD
- eliminating a dependency

    1: # The LearningOnline Network with CAPA
    2: #
    3: # $Id: lonmetadata.pm,v 1.17 2007/01/12 21:30:58 albertel Exp $
    4: #
    5: # Copyright Michigan State University Board of Trustees
    6: #
    7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    8: #
    9: # LON-CAPA is free software; you can redistribute it and/or modify
   10: # it under the terms of the GNU General Public License as published by
   11: # the Free Software Foundation; either version 2 of the License, or
   12: # (at your option) any later version.
   13: #
   14: # LON-CAPA is distributed in the hope that it will be useful,
   15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17: # GNU General Public License for more details.
   18: #
   19: # You should have received a copy of the GNU General Public License
   20: # along with LON-CAPA; if not, write to the Free Software
   21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22: #
   23: # /home/httpd/html/adm/gpl.txt
   24: #
   25: # http://www.lon-capa.org/
   26: #
   27: ######################################################################
   28: 
   29: package LONCAPA::lonmetadata;
   30: 
   31: use strict;
   32: use DBI;
   33: use HTML::TokeParser;
   34: use vars qw($Metadata_Table_Description $Portfolio_metadata_table_description 
   35: $Portfolio_access_table_description $Fulltext_indicies $Portfolio_metadata_indices $Portfolio_access_indices $Portfolio_addedfields_table_description $Portfolio_addedfields_indices);
   36: 
   37: ######################################################################
   38: ######################################################################
   39: 
   40: =pod 
   41: 
   42: =head1 Name
   43: 
   44: lonmetadata
   45: 
   46: =head1 Synopsis
   47: 
   48: lonmetadata holds a description of the metadata table and provides
   49: wrappers for the storage and retrieval of metadata to/from the database.
   50: 
   51: =head1 Description
   52: 
   53: =head1 Methods
   54: 
   55: =over 4
   56: 
   57: =cut
   58: 
   59: ######################################################################
   60: ######################################################################
   61: 
   62: =pod
   63: 
   64: =item Old table creation command
   65: 
   66: CREATE TABLE IF NOT EXISTS metadata 
   67: (title TEXT, 
   68: author TEXT, 
   69: subject TEXT, 
   70: url TEXT, 
   71: keywords TEXT, 
   72: version TEXT, 
   73: notes TEXT, 
   74: abstract TEXT, 
   75: mime TEXT, 
   76: language TEXT, 
   77: creationdate DATETIME, 
   78: lastrevisiondate DATETIME, 
   79: owner TEXT, 
   80: copyright TEXT, 
   81: domain TEXT
   82: 
   83: FULLTEXT idx_title (title), 
   84: FULLTEXT idx_author (author), 
   85: FULLTEXT idx_subject (subject), 
   86: FULLTEXT idx_url (url), 
   87: FULLTEXT idx_keywords (keywords), 
   88: FULLTEXT idx_version (version), 
   89: FULLTEXT idx_notes (notes), 
   90: FULLTEXT idx_abstract (abstract), 
   91: FULLTEXT idx_mime (mime), 
   92: FULLTEXT idx_language (language),
   93: FULLTEXT idx_owner (owner), 
   94: FULLTEXT idx_copyright (copyright)) 
   95: 
   96: TYPE=MYISAM;
   97: 
   98: =cut
   99: 
  100: ######################################################################
  101: ######################################################################
  102: $Metadata_Table_Description = 
  103:     [
  104:      { name => 'title',     type=>'TEXT'},
  105:      { name => 'author',    type=>'TEXT'},
  106:      { name => 'subject',   type=>'TEXT'},
  107:      { name => 'url',       type=>'TEXT', restrictions => 'NOT NULL' },
  108:      { name => 'keywords',  type=>'TEXT'},
  109:      { name => 'version',   type=>'TEXT'},
  110:      { name => 'notes',     type=>'TEXT'},
  111:      { name => 'abstract',  type=>'TEXT'},
  112:      { name => 'mime',      type=>'TEXT'},
  113:      { name => 'language',  type=>'TEXT'},
  114:      { name => 'creationdate',     type=>'DATETIME'},
  115:      { name => 'lastrevisiondate', type=>'DATETIME'},
  116:      { name => 'owner',     type=>'TEXT'},
  117:      { name => 'copyright', type=>'TEXT'}, 
  118:      { name => 'domain',    type=>'TEXT'},
  119:       #--------------------------------------------------
  120:      { name => 'dependencies',   type=>'TEXT'},
  121:      { name => 'modifyinguser',  type=>'TEXT'},
  122:      { name => 'authorspace',    type=>'TEXT'},
  123:      { name => 'lowestgradelevel',  type=>'INT'},
  124:      { name => 'highestgradelevel', type=>'INT'},
  125:      { name => 'standards',      type=>'TEXT'},
  126:      { name => 'count',          type=>'INT'},
  127:      { name => 'course',         type=>'INT'},
  128:      { name => 'course_list',    type=>'TEXT'},
  129:      { name => 'goto',           type=>'INT'},
  130:      { name => 'goto_list',      type=>'TEXT'},
  131:      { name => 'comefrom',       type=>'INT'},
  132:      { name => 'comefrom_list',  type=>'TEXT'},
  133:      { name => 'sequsage',       type=>'INT'},
  134:      { name => 'sequsage_list',  type=>'TEXT'},
  135:      { name => 'stdno',          type=>'INT'},
  136:      { name => 'stdno_list',     type=>'TEXT'},
  137:      { name => 'avetries',       type=>'FLOAT'},
  138:      { name => 'avetries_list',  type=>'TEXT'},
  139:      { name => 'difficulty',     type=>'FLOAT'},
  140:      { name => 'difficulty_list',type=>'TEXT'},
  141:      { name => 'disc',           type=>'FLOAT'},
  142:      { name => 'disc_list',      type=>'TEXT'},
  143:      { name => 'clear',          type=>'FLOAT'},
  144:      { name => 'technical',      type=>'FLOAT'},
  145:      { name => 'correct',        type=>'FLOAT'},
  146:      { name => 'helpful',        type=>'FLOAT'},
  147:      { name => 'depth',          type=>'FLOAT'},
  148:      { name => 'hostname',       type=> 'TEXT'},
  149:      #--------------------------------------------------
  150:     ];
  151: 
  152: $Fulltext_indicies = [ qw/ 
  153:     title
  154:     author
  155:     subject
  156:     url
  157:     keywords
  158:     version
  159:     notes
  160:     abstract
  161:     mime
  162:     language
  163:     owner
  164:     copyright/ ];
  165: 
  166: ######################################################################
  167: ######################################################################
  168: $Portfolio_metadata_table_description =
  169:     [
  170:      { name => 'title',     type=>'TEXT'},
  171:      { name => 'author',    type=>'TEXT'},
  172:      { name => 'subject',   type=>'TEXT'},
  173:      { name => 'url',       type=>'TEXT', restrictions => 'NOT NULL' },
  174:      { name => 'keywords',  type=>'TEXT'},
  175:      { name => 'version',   type=>'TEXT'},
  176:      { name => 'notes',     type=>'TEXT'},
  177:      { name => 'abstract',  type=>'TEXT'},
  178:      { name => 'mime',      type=>'TEXT'},
  179:      { name => 'language',  type=>'TEXT'},
  180:      { name => 'creationdate',     type=>'DATETIME'},
  181:      { name => 'lastrevisiondate', type=>'DATETIME'},
  182:      { name => 'owner',     type=>'TEXT'},
  183:      { name => 'copyright',     type=>'TEXT'},
  184:      { name => 'domain',    type=>'TEXT'},
  185:      { name => 'groupname',     type=>'TEXT'},
  186:      { name => 'courserestricted', type=>'TEXT'},
  187:      { name => 'addedfieldnames',  type=>'TEXT'},
  188:      { name => 'addedfieldvalues', type=>'TEXT'},
  189:       #--------------------------------------------------
  190:      { name => 'dependencies',   type=>'TEXT'},
  191:      { name => 'modifyinguser',  type=>'TEXT'},
  192:      { name => 'authorspace',    type=>'TEXT'},
  193:      { name => 'lowestgradelevel',  type=>'INT'},
  194:      { name => 'highestgradelevel', type=>'INT'},
  195:      { name => 'standards',      type=>'TEXT'},
  196:      { name => 'hostname',       type=> 'TEXT'},
  197:      #--------------------------------------------------
  198:    ];
  199: 
  200: $Portfolio_metadata_indices = [qw/
  201:     title
  202:     author
  203:     subject
  204:     url
  205:     keywords
  206:     version
  207:     notes
  208:     abstract
  209:     mime
  210:     language
  211:     owner/];
  212: 
  213: ######################################################################
  214: ######################################################################
  215: 
  216: $Portfolio_access_table_description =
  217:     [
  218:      { name => 'url',   type=>'TEXT', restrictions => 'NOT NULL' },
  219:      { name => 'keynum', type=>'TEXT', restrictions => 'NOT NULL' },
  220:      { name => 'scope', type=>'TEXT'},
  221:      { name => 'start', type=>'DATETIME'},
  222:      { name => 'end',   type=>'DATETIME'},
  223:    ];
  224: 
  225: $Portfolio_access_indices = [qw/
  226:     url
  227:     keynum
  228:     scope
  229:     start
  230:     end/];
  231: 
  232: ######################################################################
  233: ######################################################################
  234: 
  235: $Portfolio_addedfields_table_description =
  236:     [
  237:      { name => 'url',   type=>'TEXT', restrictions => 'NOT NULL' },
  238:      { name => 'field', type=>'TEXT', restrictions => 'NOT NULL' },
  239:      { name => 'courserestricted', type=>'TEXT', restrictions => 'NOT NULL' },
  240:      { name => 'value', type=>'TEXT'},
  241:    ];
  242: 
  243: $Portfolio_addedfields_indices = [qw/
  244:     url
  245:     field
  246:     value
  247:     courserestricted/];
  248: 
  249: ######################################################################
  250: ######################################################################
  251: 
  252: 
  253: =pod
  254: 
  255: =item &describe_metadata_storage
  256: 
  257: Input: None
  258: 
  259: Returns: An array of hash references describing the columns and indicies
  260: of the metadata table(s).
  261: 
  262: =cut
  263: 
  264: ######################################################################
  265: ######################################################################
  266: sub describe_metadata_storage {
  267:     my ($tabletype) = @_;
  268:     my %table_description = (
  269:         metadata              => $Metadata_Table_Description,
  270:         portfolio_metadata    => $Portfolio_metadata_table_description,
  271:         portfolio_access      => $Portfolio_access_table_description,
  272:         portfolio_addedfields => $Portfolio_addedfields_table_description, 
  273:     );
  274:     my %index_description = (
  275:         metadata              => $Fulltext_indicies,
  276:         portfolio_metadata    => $Portfolio_metadata_indices,
  277:         portfolio_access      => $Portfolio_access_indices,
  278:         portfolio_addedfields => $Portfolio_addedfields_indices,
  279:     );
  280:     if ($tabletype eq 'portfolio_search') {
  281:         my @portfolio_search_table = @{$table_description{portfolio_metadata}};
  282:         foreach my $item (@{$table_description{portfolio_access}}) {
  283:             if (ref($item) eq 'HASH') {
  284:                 if ($item->{'name'} eq 'url') {
  285:                     next;
  286:                 }
  287:             }
  288:             push(@portfolio_search_table,$item);
  289:         }
  290:         my @portfolio_search_indices = @{$index_description{portfolio_metadata}};
  291:         push(@portfolio_search_indices,('scope','keynum'));
  292:         return (\@portfolio_search_table,\@portfolio_search_indices);
  293:     } else {
  294:         return ($table_description{$tabletype},$index_description{$tabletype});
  295:     }
  296: }
  297: 
  298: ######################################################################
  299: ######################################################################
  300: 
  301: =pod
  302: 
  303: =item create_metadata_storage()
  304: 
  305: Inputs: table name (optional): the name of the table.  Default is 'metadata'.
  306: 
  307: Returns: A perl string which, when executed by MySQL, will cause the
  308: metadata storage to be initialized.
  309: 
  310: =cut
  311: 
  312: ######################################################################
  313: ######################################################################
  314: sub create_metadata_storage { 
  315:     my ($tablename,$tabletype) = @_;
  316:     $tablename = 'metadata' if (! defined($tablename));
  317:     $tabletype = 'metadata' if (! defined($tabletype));
  318:     my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
  319:     #
  320:     # Process the columns  (this code is stolen from lonmysql.pm)
  321:     my @Columns;
  322:     my $col_des; # mysql column description
  323:     my ($table_columns,$table_indices) = 
  324:                           &describe_metadata_storage($tabletype);
  325:     my %coltype;
  326:     foreach my $coldata (@{$table_columns}) {
  327:         my $column = $coldata->{'name'};
  328:         $coltype{$column} = $coldata->{'type'};
  329:         $col_des = '';
  330:         if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
  331:             $col_des.=$column." ".$coldata->{'type'}."('".
  332:                 join("', '",@{$coldata->{'values'}})."')";
  333:         } else {
  334:             $col_des.=$column." ".$coldata->{'type'};
  335:             if (exists($coldata->{'size'})) {
  336:                 $col_des.="(".$coldata->{'size'}.")";
  337:             }
  338:         }
  339:         # Modifiers
  340:         if (exists($coldata->{'restrictions'})){
  341:             $col_des.=" ".$coldata->{'restrictions'};
  342:         }
  343:         if (exists($coldata->{'default'})) {
  344:             $col_des.=" DEFAULT '".$coldata->{'default'}."'";
  345:         }
  346:         $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) &&
  347:                                         ($coldata->{'auto_inc'} eq 'yes'));
  348:         $col_des.=' PRIMARY KEY'    if (exists($coldata->{'primary_key'}) &&
  349:                                         ($coldata->{'primary_key'} eq 'yes'));
  350:     } continue {
  351:         # skip blank items.
  352:         push (@Columns,$col_des) if ($col_des ne '');
  353:     }
  354:     foreach my $colname (@{$table_indices}) {
  355:         my $text;
  356:         if ($coltype{$colname} eq 'TEXT') {
  357:             $text = 'FULLTEXT ';
  358:         } else {
  359:             $text = 'INDEX ';
  360:         }
  361:         $text .= 'idx_'.$colname.' ('.$colname.')';
  362:         push (@Columns,$text);
  363:     }
  364:     $request .= "(".join(", ",@Columns).") TYPE=MyISAM";
  365:     return $request;
  366: }
  367: 
  368: ######################################################################
  369: ######################################################################
  370: 
  371: =pod
  372: 
  373: =item store_metadata()
  374: 
  375: Inputs: database handle ($dbh), a table name, table type and a hash or hash 
  376: reference containing the metadata for a single resource.
  377: 
  378: Returns: 1 on success, 0 on failure to store.
  379: 
  380: =cut
  381: 
  382: ######################################################################
  383: ######################################################################
  384: {
  385:     ##
  386:     ##  WARNING: The following cleverness may cause trouble in cases where
  387:     ##  the dbi connection is dropped and recreated - a stale statement
  388:     ##  handler may linger around and cause trouble.
  389:     ##
  390:     ##  In most scripts, this will work fine.  If the dbi is going to be
  391:     ##  dropped and (possibly) later recreated, call &clear_sth.  Yes it
  392:     ##  is annoying but $sth apparently does not have a link back to the 
  393:     ##  $dbh, so we can't check our validity.
  394:     ##
  395:     my $sth = undef;
  396:     my $sth_table = undef;
  397: 
  398: sub create_statement_handler {
  399:     my ($dbh,$tablename,$tabletype) = @_;
  400:     $tablename = 'metadata' if (! defined($tablename));
  401:     $tabletype = 'metadata' if (! defined($tabletype));
  402:     my ($table_columns,$table_indices) = 
  403:           &describe_metadata_storage($tabletype);
  404:     $sth_table = $tablename;
  405:     my $request = 'INSERT INTO '.$tablename.' VALUES(';
  406:     foreach (@{$table_columns}) {
  407:         $request .= '?,';
  408:     }
  409:     chop $request;
  410:     $request.= ')';
  411:     $sth = $dbh->prepare($request);
  412:     return;
  413: }
  414: 
  415: sub clear_sth { $sth=undef; $sth_table=undef;}
  416: 
  417: sub store_metadata {
  418:     my ($dbh,$tablename,$tabletype,@Metadata)=@_;
  419:     my $errors = '';
  420:     if (! defined($sth) || 
  421:         ( defined($tablename) && ($sth_table ne $tablename)) || 
  422:         (! defined($tablename) && $sth_table ne 'metadata')) {
  423:         &create_statement_handler($dbh,$tablename,$tabletype);
  424:     }
  425:     my $successcount = 0;
  426:     if (! defined($tabletype)) {
  427:         $tabletype = 'metadata';
  428:     }
  429:     my ($table_columns,$table_indices) = 
  430:                         &describe_metadata_storage($tabletype);
  431:     foreach my $mdata (@Metadata) {
  432:         next if (ref($mdata) ne "HASH");
  433:         my @MData;
  434:         foreach my $field (@{$table_columns}) {
  435:             my $fname = $field->{'name'};
  436:             if (exists($mdata->{$fname}) && 
  437:                 defined($mdata->{$fname}) &&
  438:                 $mdata->{$fname} ne '') {
  439:                 if ($mdata->{$fname} eq 'nan' ||
  440:                     $mdata->{$fname} eq '') {
  441:                     push(@MData,'NULL');
  442:                 } else {
  443:                     push(@MData,$mdata->{$fname});
  444:                 }
  445:             } else {
  446:                 push(@MData,undef);
  447:             }
  448:         }
  449:         $sth->execute(@MData);
  450:         if (! $sth->err) {
  451:             $successcount++;
  452:         } else {
  453:             $errors = join(',',$errors,$sth->errstr);
  454:         }
  455:         $errors =~ s/^,//;
  456:     }
  457:     if (wantarray()) {
  458:         return ($successcount,$errors);
  459:     } else {
  460:         return $successcount;
  461:     }
  462: }
  463: 
  464: }
  465: 
  466: ######################################################################
  467: ######################################################################
  468: 
  469: =pod
  470: 
  471: =item lookup_metadata()
  472: 
  473: Inputs: database handle ($dbh) and a hash or hash reference containing 
  474: metadata which will be used for a search.
  475: 
  476: Returns: scalar with error string on failure, array reference on success.
  477: The array reference is the same one returned by $sth->fetchall_arrayref().
  478: 
  479: =cut
  480: 
  481: ######################################################################
  482: ######################################################################
  483: sub lookup_metadata {
  484:     my ($dbh,$condition,$fetchparameter,$tablename) = @_;
  485:     $tablename = 'metadata' if (! defined($tablename));
  486:     my $error;
  487:     my $returnvalue=[];
  488:     my $request = 'SELECT * FROM '.$tablename;
  489:     if (defined($condition)) {
  490:         $request .= ' WHERE '.$condition;
  491:     }
  492:     my $sth = $dbh->prepare($request);
  493:     if ($sth->err) {
  494:         $error = $sth->errstr;
  495:     }
  496:     if (! $error) {
  497:         $sth->execute();
  498:         if ($sth->err) {
  499:             $error = $sth->errstr;
  500:         } else {
  501:             $returnvalue = $sth->fetchall_arrayref($fetchparameter);
  502:             if ($sth->err) {
  503:                 $error = $sth->errstr;
  504:             }
  505:         }
  506:     } 
  507:     return ($error,$returnvalue);
  508: }
  509: 
  510: ######################################################################
  511: ######################################################################
  512: 
  513: =pod
  514: 
  515: =item delete_metadata()
  516: 
  517: Removes a single metadata record, based on its url.
  518: 
  519: Inputs: $dbh, the database handler.
  520: $tablename, the name of the metadata table to remove from. default: 'metadata'
  521: $url, the url of the resource to remove from the metadata database.
  522: 
  523: Returns: undef on success, dbh errorstr on failure.
  524: 
  525: =cut
  526: 
  527: ######################################################################
  528: ######################################################################
  529: sub delete_metadata {
  530:     my ($dbh,$tablename,$url) = @_;
  531:     $tablename = 'metadata' if (! defined($tablename));
  532:     my $error;
  533:     my $delete_command = 'DELETE FROM '.$tablename.' WHERE url='.
  534:         $dbh->quote($url);
  535:     $dbh->do($delete_command);
  536:     if ($dbh->err) {
  537:         $error = $dbh->errstr();
  538:     }
  539:     return $error;
  540: }
  541: 
  542: ######################################################################
  543: ######################################################################
  544: 
  545: =pod
  546: 
  547: =item update_metadata
  548: 
  549: Updates metadata record in mysql database.  It does not matter if the record
  550: currently exists.  Fields not present in the new metadata will be taken
  551: from the current record, if it exists.  To delete an entry for a key, set 
  552: it to "" or undef.
  553: 
  554: Inputs: 
  555: $dbh, database handle
  556: $newmetadata, hash reference containing the new metadata
  557: $tablename, metadata table name.  Defaults to 'metadata'.
  558: $tabletype, type of table (metadata, portfolio_metadata, portfolio_access)  
  559: 
  560: Returns:
  561: $error on failure.  undef on success.
  562: 
  563: =cut
  564: 
  565: ######################################################################
  566: ######################################################################
  567: sub update_metadata {
  568:     my ($dbh,$tablename,$tabletype,$newmetadata)=@_;
  569:     my $error;
  570:     $tablename = 'metadata' if (! defined($tablename));
  571:     $tabletype = 'metadata' if (! defined($tabletype));
  572:     if (! exists($newmetadata->{'url'})) {
  573:         $error = 'Unable to update: no url specified';
  574:     }
  575:     return $error if (defined($error));
  576:     # 
  577:     # Retrieve current values
  578:     my $row;
  579:     ($error,$row) = &lookup_metadata($dbh,
  580:                                    ' url='.$dbh->quote($newmetadata->{'url'}),
  581:                                      undef,$tablename);
  582:     return $error if ($error);
  583:     my %metadata = &LONCAPA::lonmetadata::metadata_col_to_hash($tabletype,@{$row->[0]});
  584:     #
  585:     # Update metadata values
  586:     while (my ($key,$value) = each(%$newmetadata)) {
  587:         $metadata{$key} = $value;
  588:     }
  589:     #
  590:     # Delete old data (deleting a nonexistant record does not produce an error.
  591:     $error = &delete_metadata($dbh,$tablename,$newmetadata->{'url'});
  592:     return $error if (defined($error));
  593:     #
  594:     # Store updated metadata
  595:     my $success;
  596:     ($success,$error) = &store_metadata($dbh,$tablename,$tabletype,\%metadata);
  597:     return $error;
  598: }
  599: 
  600: ######################################################################
  601: ######################################################################
  602: 
  603: =pod
  604: 
  605: =item metdata_col_to_hash
  606: 
  607: Input: Array of metadata columns
  608: 
  609: Return: Hash with the metadata columns as keys and the array elements
  610: passed in as values
  611: 
  612: =cut
  613: 
  614: ######################################################################
  615: ######################################################################
  616: sub metadata_col_to_hash {
  617:     my ($tabletype,@cols)=@_;
  618:     my %hash=();
  619:     my ($columns,$indices) = &describe_metadata_storage($tabletype);
  620:     for (my $i=0; $i<@{$columns};$i++) {
  621:         $hash{$columns->[$i]->{'name'}}=$cols[$i];
  622: 	unless ($hash{$columns->[$i]->{'name'}}) {
  623: 	    if ($columns->[$i]->{'type'} eq 'TEXT') {
  624: 		$hash{$columns->[$i]->{'name'}}='';
  625: 	    } elsif ($columns->[$i]->{'type'} eq 'DATETIME') {
  626: 		$hash{$columns->[$i]->{'name'}}='0000-00-00 00:00:00';
  627: 	    } else {
  628: 		$hash{$columns->[$i]->{'name'}}=0;
  629: 	    }
  630: 	}
  631:     }
  632:     return %hash;
  633: }
  634: 
  635: ######################################################################
  636: ######################################################################
  637: 
  638: =pod
  639: 
  640: =item nohist_resevaldata.db data structure
  641: 
  642: The nohist_resevaldata.db file has the following possible keys:
  643: 
  644:  Statistics Data (values are integers, perl times, or real numbers)
  645:  ------------------------------------------
  646:  $course___$resource___avetries
  647:  $course___$resource___count
  648:  $course___$resource___difficulty
  649:  $course___$resource___stdno
  650:  $course___$resource___timestamp
  651: 
  652:  Evaluation Data (values are on a 1 to 5 scale)
  653:  ------------------------------------------
  654:  $username@$dom___$resource___clear
  655:  $username@$dom___$resource___comments
  656:  $username@$dom___$resource___depth
  657:  $username@$dom___$resource___technical
  658:  $username@$dom___$resource___helpful
  659:  $username@$dom___$resource___correct
  660: 
  661:  Course Context Data
  662:  ------------------------------------------
  663:  $course___$resource___course       course id
  664:  $course___$resource___comefrom     resource preceeding this resource
  665:  $course___$resource___goto         resource following this resource
  666:  $course___$resource___usage        resource containing this resource
  667: 
  668:  New statistical data storage
  669:  ------------------------------------------
  670:  $course&$sec&$numstud___$resource___stats
  671:     $sec is a string describing the sections: all, 1 2, 1 2 3,...
  672:     Value is a '&' deliminated list of key=value pairs.
  673:     Possible keys are (currently) disc,course,sections,difficulty, 
  674:     stdno, timestamp
  675: 
  676: =cut
  677: 
  678: ######################################################################
  679: ######################################################################
  680: 
  681: =pod
  682: 
  683: =item &process_reseval_data 
  684: 
  685: Process a nohist_resevaldata hash into a more complex data structure.
  686: 
  687: Input: Hash reference containing reseval data
  688: 
  689: Returns: Hash with the following structure:
  690: 
  691: $hash{$url}->{'statistics'}->{$courseid}->{'avetries'}   = $value
  692: $hash{$url}->{'statistics'}->{$courseid}->{'count'}      = $value
  693: $hash{$url}->{'statistics'}->{$courseid}->{'difficulty'} = $value
  694: $hash{$url}->{'statistics'}->{$courseid}->{'stdno'}      = $value
  695: $hash{$url}->{'statistics'}->{$courseid}->{'timestamp'}  = $value
  696: 
  697: $hash{$url}->{'evaluation'}->{$username}->{'clear'}     = $value
  698: $hash{$url}->{'evaluation'}->{$username}->{'comments'}  = $value
  699: $hash{$url}->{'evaluation'}->{$username}->{'depth'}     = $value
  700: $hash{$url}->{'evaluation'}->{$username}->{'technical'} = $value
  701: $hash{$url}->{'evaluation'}->{$username}->{'helpful'}   = $value
  702: 
  703: $hash{$url}->{'course'}    = \@Courses
  704: $hash{$url}->{'comefrom'}  = \@Resources
  705: $hash{$url}->{'goto'}      = \@Resources
  706: $hash{$url}->{'usage'}     = \@Resources
  707: 
  708: $hash{$url}->{'stats'}->{$courseid\_$section}->{$key} = $value
  709: 
  710: =cut
  711: 
  712: ######################################################################
  713: ######################################################################
  714: sub process_reseval_data {
  715:     my ($evaldata) = @_;
  716:     my %DynamicData;
  717:     #
  718:     # Process every stored element
  719:     while (my ($storedkey,$value) = each(%{$evaldata})) {
  720:         my ($source,$file,$type) = split('___',$storedkey);
  721:         $source = &unescape($source);
  722:         $file = &unescape($file);
  723:         $value = &unescape($value);
  724:          "    got ".$file."\n        ".$type." ".$source."\n";
  725:         if ($type =~ /^(avetries|count|difficulty|stdno|timestamp)$/) {
  726:             #
  727:             # Statistics: $source is course id
  728:             $DynamicData{$file}->{'statistics'}->{$source}->{$type}=$value;
  729:         } elsif ($type =~ /^(clear|comments|depth|technical|helpful|correct)$/){
  730:             #
  731:             # Evaluation $source is username, check if they evaluated it
  732:             # more than once.  If so, pad the entry with a space.
  733:             while(exists($DynamicData{$file}->{'evaluation'}->{$type}->{$source})) {
  734:                 $source .= ' ';
  735:             }
  736:             $DynamicData{$file}->{'evaluation'}->{$type}->{$source}=$value;
  737:         } elsif ($type =~ /^(course|comefrom|goto|usage)$/) {
  738:             #
  739:             # Context $source is course id or resource
  740:             push(@{$DynamicData{$file}->{$type}},&unescape($source));
  741:         } elsif ($type eq 'stats') {
  742:             #
  743:             # Statistics storage...
  744:             # $source is $cid\_$sec\_$stdno
  745:             # $value is stat1=value&stat2=value&stat3=value,....
  746:             #
  747:             my ($cid,$sec,$stdno)=split('&',$source);
  748:             my $crssec = $cid.'&'.$sec;
  749:             my @Data = split('&',$value);
  750:             my %Statistics;
  751:             while (my ($key,$value) = split('=',pop(@Data))) {
  752:                 $Statistics{$key} = $value;
  753:             }
  754:             $sec =~ s:("$|^")::g;
  755:             $Statistics{'sections'} = $sec;
  756:             #
  757:             # Only store the data if the number of students is greater
  758:             # than the data already stored
  759:             if (! exists($DynamicData{$file}->{'stats'}->{$crssec}) ||
  760:                 $DynamicData{$file}->{'stats'}->{$crssec}->{'stdno'}<$stdno){
  761:                 $DynamicData{$file}->{'stats'}->{$crssec}=\%Statistics;
  762:             }
  763:         }
  764:     }
  765:     return %DynamicData;
  766: }
  767: 
  768: 
  769: ######################################################################
  770: ######################################################################
  771: 
  772: =pod
  773: 
  774: =item &process_dynamic_metadata
  775: 
  776: Inputs: $url: the url of the item to process
  777: $DynamicData: hash reference for the results of &process_reseval_data
  778: 
  779: Returns: Hash containing the following keys:
  780:     avetries, avetries_list, difficulty, difficulty_list, stdno, stdno_list,
  781:     course, course_list, goto, goto_list, comefrom, comefrom_list,
  782:     usage, clear, technical, correct, helpful, depth, comments
  783: 
  784:     Each of the return keys is associated with either a number or a string
  785:     The *_list items are comma-seperated strings.  'comments' is a string
  786:     containing generically marked-up comments.
  787: 
  788: =cut
  789: 
  790: ######################################################################
  791: ######################################################################
  792: sub process_dynamic_metadata {
  793:     my ($url,$DynamicData) = @_;
  794:     my %data;
  795:     my $resdata = $DynamicData->{$url};
  796:     #
  797:     # Get the statistical data - Use a weighted average
  798:     foreach my $type (qw/avetries difficulty disc/) {
  799:         my $studentcount;
  800:         my $sum;
  801:         my @Values;
  802:         my @Students;
  803:         #
  804:         # Old data
  805:         foreach my $coursedata (values(%{$resdata->{'statistics'}}),
  806:                                 values(%{$resdata->{'stats'}})) {
  807:             if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) {
  808:                 $studentcount += $coursedata->{'stdno'};
  809:                 $sum += ($coursedata->{$type}*$coursedata->{'stdno'});
  810:                 push(@Values,$coursedata->{$type});
  811:                 push(@Students,$coursedata->{'stdno'});
  812:             }
  813:         }
  814:         if (exists($resdata->{'stats'})) {
  815:             foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
  816:                 my $coursedata = $resdata->{'stats'}->{$identifier};
  817:                 $studentcount += $coursedata->{'stdno'};
  818:                 $sum += $coursedata->{$type}*$coursedata->{'stdno'};
  819:                 push(@Values,$coursedata->{$type});                
  820:                 push(@Students,$coursedata->{'stdno'});
  821:             }
  822:         }
  823:         #
  824:         # New data
  825:         if (defined($studentcount) && $studentcount>0) {
  826:             $data{$type} = $sum/$studentcount;
  827:             $data{$type.'_list'} = join(',',@Values);
  828:         }
  829:     }
  830:     #
  831:     # Find out the number of students who have completed the resource...
  832:     my $stdno;
  833:     foreach my $coursedata (values(%{$resdata->{'statistics'}}),
  834:                             values(%{$resdata->{'stats'}})) {
  835:         if (ref($coursedata) eq 'HASH' && exists($coursedata->{'stdno'})) {
  836:             $stdno += $coursedata->{'stdno'};
  837:         }
  838:     }
  839:     if (exists($resdata->{'stats'})) {
  840:         #
  841:         # For the number of students, take the maximum found for the class
  842:         my $current_course;
  843:         my $coursemax=0;
  844:         foreach my $identifier (sort(keys(%{$resdata->{'stats'}}))) {
  845:             my $coursedata = $resdata->{'stats'}->{$identifier};
  846:             if (! defined($current_course)) {
  847:                 $current_course = $coursedata->{'course'};
  848:             }
  849:             if ($current_course ne $coursedata->{'course'}) {
  850:                 $stdno += $coursemax;
  851:                 $coursemax = 0;
  852:                 $current_course = $coursedata->{'course'};                
  853:             }
  854:             if ($coursemax < $coursedata->{'stdno'}) {
  855:                 $coursemax = $coursedata->{'stdno'};
  856:             }
  857:         }
  858:         $stdno += $coursemax; # pick up the final course in the list
  859:     }
  860:     $data{'stdno'}=$stdno;
  861:     #
  862:     # Get the context data
  863:     foreach my $type (qw/course goto comefrom/) {
  864:         if (defined($resdata->{$type}) && 
  865:             ref($resdata->{$type}) eq 'ARRAY') {
  866:             $data{$type} = scalar(@{$resdata->{$type}});
  867:             $data{$type.'_list'} = join(',',@{$resdata->{$type}});
  868:         }
  869:     }
  870:     if (defined($resdata->{'usage'}) && 
  871:         ref($resdata->{'usage'}) eq 'ARRAY') {
  872:         $data{'sequsage'} = scalar(@{$resdata->{'usage'}});
  873:         $data{'sequsage_list'} = join(',',@{$resdata->{'usage'}});
  874:     }
  875:     #
  876:     # Get the evaluation data
  877:     foreach my $type (qw/clear technical correct helpful depth/) {
  878:         my $count;
  879:         my $sum;
  880:         foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{$type}})){
  881:             $sum += $resdata->{'evaluation'}->{$type}->{$evaluator};
  882:             $count++;
  883:         }
  884:         if ($count > 0) {
  885:             $data{$type}=$sum/$count;
  886:         }
  887:     }
  888:     #
  889:     # put together comments
  890:     my $comments = '<div class="LCevalcomments">';
  891:     foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{'comments'}})){
  892:         $comments .= 
  893:             '<p>'.
  894:             '<b>'.$evaluator.'</b>:'.
  895:             $resdata->{'evaluation'}->{'comments'}->{$evaluator}.
  896:             '</p>';
  897:     }
  898:     $comments .= '</div>';
  899:     $data{'comments'} = $comments;
  900:     #
  901:     if (exists($resdata->{'stats'})) {
  902:         $data{'stats'} = $resdata->{'stats'};
  903:     }
  904:     if (exists($DynamicData->{'domain'})) {
  905:         $data{'domain'} = $DynamicData->{'domain'};
  906:     }
  907:     #
  908:     return %data;
  909: }
  910: 
  911: sub dynamic_metadata_storage {
  912:     my ($data) = @_;
  913:     my %Store;
  914:     my $courseid = $data->{'course'};
  915:     my $sections = $data->{'sections'};
  916:     my $numstu = $data->{'num_students'};
  917:     my $urlres = $data->{'urlres'};
  918:     my $key = $courseid.'&'.$sections.'&'.$numstu.'___'.$urlres.'___stats';
  919:     $Store{$key} =
  920:         'course='.$courseid.'&'.
  921:         'sections='.$sections.'&'.
  922:         'timestamp='.time.'&'.
  923:         'stdno='.$data->{'num_students'}.'&'.
  924:         'avetries='.$data->{'mean_tries'}.'&'.
  925:         'difficulty='.$data->{'deg_of_diff'};
  926:     if (exists($data->{'deg_of_disc'})) {
  927:         $Store{$key} .= '&'.'disc='.$data->{'deg_of_disc'};
  928:     }
  929:     return %Store;
  930: }
  931: 
  932: ###############################################################
  933: ###############################################################
  934: ###                                                         ###
  935: ###  &portfolio_metadata($filepath,$dom,$uname,$group)      ###
  936: ###   Retrieve metadata for the given file                  ###
  937: ###   Returns array -                                       ###
  938: ###      contains reference to metadatahash and             ###
  939: ###         optional reference to addedfields hash          ###
  940: ###                                                         ###
  941: ###############################################################
  942: ###############################################################
  943: 
  944: sub portfolio_metadata {
  945:     my ($fullpath,$dom,$uname,$group)=@_;
  946:     my ($mime) = ( $fullpath=~/\.(\w+)$/ );
  947:     my %metacache=();
  948:     if ($fullpath !~ /\.meta$/) {
  949:         $fullpath .= '.meta';
  950:     }
  951:     my (@standard_fields,%addedfields);
  952:     my $colsref = $Portfolio_metadata_table_description;
  953:     if (ref($colsref) eq 'ARRAY') {
  954:         my @columns = @{$colsref};
  955:         foreach my $coldata (@columns) {
  956:             push(@standard_fields,$coldata->{'name'});
  957:         }
  958:     }
  959:     my $metastring=&getfile($fullpath);
  960:     if (! defined($metastring)) {
  961:         $metacache{'keys'}= 'owner,domain,mime';
  962:         $metacache{'owner'} = $uname.':'.$dom;
  963:         $metacache{'domain'} = $dom;
  964:         $metacache{'mime'} = $mime;
  965:         if ($group ne '') {
  966:             $metacache{'keys'} .= ',courserestricted';
  967:             $metacache{'courserestricted'} = 'course.'.$dom.'_'.$uname;
  968:         }
  969:     } else {
  970:         my $parser=HTML::TokeParser->new(\$metastring);
  971:         my $token;
  972:         while ($token=$parser->get_token) {
  973:             if ($token->[0] eq 'S') {
  974:                 my $entry=$token->[1];
  975:                 if ($metacache{'keys'}) {
  976:                     $metacache{'keys'}.=','.$entry;
  977:                 } else {
  978:                     $metacache{'keys'}=$entry;
  979:                 }
  980:                 my $value = $parser->get_text('/'.$entry);
  981:                 if (!grep(/^\Q$entry\E$/,@standard_fields)) {
  982:                     my $clean_value = lc($value);
  983:                     $clean_value =~ s/\s/_/g;
  984:                     if ($clean_value ne $entry) {
  985:                         if (defined($addedfields{$entry})) {
  986:                             $addedfields{$entry} .=','.$value;
  987:                         } else {
  988:                             $addedfields{$entry} = $value;
  989:                         }
  990:                     }
  991:                 } else {
  992:                     $metacache{$entry} = $value;
  993:                 }
  994:             }
  995:         } # End of ($token->[0] eq 'S')
  996:     }
  997:     if (keys(%addedfields) > 0) {
  998:         foreach my $key (sort keys(%addedfields)) {
  999:             $metacache{'addedfieldnames'} .= $key.',';
 1000:             $metacache{'addedfieldvalues'} .= $addedfields{$key}.'&&&';
 1001:         }
 1002:         $metacache{'addedfieldnames'} =~ s/,$//;
 1003:         $metacache{'addedfieldvalues'} =~ s/\&\&\&$//;
 1004:         if ($metacache{'keys'}) {
 1005:             $metacache{'keys'}.=',addedfieldnames';
 1006:         } else {
 1007:             $metacache{'keys'}='addedfieldnames';
 1008:         }
 1009:         $metacache{'keys'}.=',addedfieldvalues';
 1010:     }
 1011:     return (\%metacache,$metacache{'courserestricted'},\%addedfields);
 1012: }
 1013: 
 1014: sub process_portfolio_access_data {
 1015:     my ($dbh,$simulate,$newnames,$url,$fullpath,$access_hash,$caller) = @_;
 1016:     my %loghash;
 1017:     if ($caller eq 'update') {
 1018:         # Delete old data (no error if deleting non-existent record).
 1019:         my $error=&delete_metadata($dbh,$newnames->{'access'},$url);
 1020:         if (defined($error)) {
 1021:             $loghash{'access'}{'err'} = "MySQL Error Delete: ".$error;
 1022:             return %loghash;
 1023:         }
 1024:     }
 1025:     # Check the file exists
 1026:     if (-e $fullpath) {
 1027:         foreach my $key (keys(%{$access_hash})) {
 1028:             my $acc_data;
 1029:             $acc_data->{url} = $url;
 1030:             $acc_data->{keynum} = $key;
 1031:             my ($num,$scope,$end,$start) =
 1032:                             ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
 1033:             next if (($scope ne 'public') && ($scope ne 'guest'));
 1034:             $acc_data->{scope} = $scope;
 1035:             if ($end != 0) {
 1036:                 $acc_data->{end} = &sqltime($end);
 1037:             }
 1038:             $acc_data->{start} = &sqltime($start);
 1039:             if (! $simulate) {
 1040:                 my ($count,$err) =
 1041:                      &store_metadata($dbh,$newnames->{'access'},
 1042:                                      'portfolio_access',$acc_data);
 1043:                 if ($err) {
 1044:                     $loghash{$key}{'err'} = "MySQL Error Insert: ".$err;
 1045:                 }
 1046:                 if ($count < 1) {
 1047:                     $loghash{$key}{'count'} = 
 1048:                         "Unable to insert record into MySQL database for $url";
 1049:                 }
 1050:             }
 1051:         }
 1052:     }
 1053:     return %loghash;
 1054: }
 1055: 
 1056: sub process_portfolio_metadata {
 1057:     my ($dbh,$simulate,$newnames,$url,$fullpath,$is_course,$dom,$uname,$group,$caller) = @_;
 1058:     my %loghash;
 1059:     if ($caller eq 'update') {
 1060:         # Delete old data (no error if deleting non-existent record).
 1061:         my $error=&delete_metadata($dbh,$newnames->{'portfolio'},$url);
 1062:         if (defined($error)) {
 1063:             $loghash{'metadata'}{'err'} = "MySQL Error delete metadata: ".
 1064:                                                $error;
 1065:             return %loghash;
 1066:         }
 1067:         $error=&delete_metadata($dbh,$newnames->{'addedfields'},$url);
 1068:         if (defined($error)) {
 1069:             $loghash{'addedfields'}{'err'}="MySQL Error delete addedfields: ".$error;
 1070:         }
 1071:     }
 1072:     # Check the file exists.
 1073:     if (-e $fullpath) {
 1074:         my ($ref,$crs,$addedfields) = &portfolio_metadata($fullpath,$dom,$uname,
 1075:                                                           $group);
 1076:         &getfiledates($ref,$fullpath);
 1077:         if ($is_course) {
 1078:             $ref->{'groupname'} = $group;
 1079:         }
 1080:         my %Data;
 1081:         if (ref($ref) eq 'HASH') {
 1082:             %Data = %{$ref};
 1083:         }
 1084:         %Data = (
 1085:                  %Data,
 1086:                  'url'=>$url,
 1087:                  'version'=>'current',
 1088:         );
 1089:         my %loghash;
 1090:         if (! $simulate) {
 1091:             my ($count,$err) =
 1092:             &store_metadata($dbh,$newnames->{'portfolio'},'portfolio_metadata',
 1093:                             \%Data);
 1094:             if ($err) {
 1095:                 $loghash{'metadata'."\0"}{'err'} = "MySQL Error Insert: ".$err;
 1096:             }
 1097:             if ($count < 1) {
 1098:                 $loghash{'metadata'."\0"}{'count'} = "Unable to insert record into MySQL portfolio_metadata database table for $url";
 1099:             }
 1100:             if (ref($addedfields) eq 'HASH') {
 1101:                 if (keys(%{$addedfields}) > 0) {
 1102:                     foreach my $key (keys(%{$addedfields})) {
 1103:                         my $added_data = {
 1104:                                     'url'   => $url,
 1105:                                     'field' => $key,
 1106:                                     'value' => $addedfields->{$key},
 1107:                                     'courserestricted' => $crs,
 1108:                         };
 1109:                         my ($count,$err) = 
 1110:                             &store_metadata($dbh,$newnames->{'addedfields'},
 1111:                                    'portfolio_addedfields',$added_data);
 1112:                         if ($err) {
 1113:                             $loghash{$key}{'err'} = 
 1114:                                 "MySQL Error Insert: ".$err;
 1115:                         }
 1116:                         if ($count < 1) {
 1117:                             $loghash{$key}{'count'} = "Unable to insert record into MySQL portfolio_addedfields database table for url = $url and field = $key";
 1118:                         }
 1119:                     }
 1120:                 }
 1121:             }
 1122:         }
 1123:     }
 1124:     return %loghash;
 1125: }
 1126: 
 1127: ######################################################################
 1128: ######################################################################
 1129: 
 1130: ## Utilities originally in searchcat.pl.  Moved to be more widely available.
 1131: 
 1132: sub getfile {
 1133:     my $file = shift();
 1134:     if (! -e $file ) { 
 1135:         return undef; 
 1136:     }
 1137:     open(my $fh,"<$file");
 1138:     my $contents = '';
 1139:     while (<$fh>) { 
 1140:         $contents .= $_;
 1141:     }
 1142:     return $contents;
 1143: }
 1144: 
 1145: ##
 1146: ## &getfiledates()
 1147: ## Converts creationdate and modifieddates to SQL format
 1148: ## Applies stat() to file to retrieve dates if missing
 1149: sub getfiledates {
 1150:     my ($ref,$target) = @_;
 1151:     if (! defined($ref->{'creationdate'}) ||
 1152:         $ref->{'creationdate'} =~ /^\s*$/) {
 1153:         $ref->{'creationdate'} = (stat($target))[9];
 1154:     }
 1155:     if (! defined($ref->{'lastrevisiondate'}) ||
 1156:         $ref->{'lastrevisiondate'} =~ /^\s*$/) {
 1157:         $ref->{'lastrevisiondate'} = (stat($target))[9];
 1158:     }
 1159:     $ref->{'creationdate'}     = &sqltime($ref->{'creationdate'});
 1160:     $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'});
 1161: }
 1162:  
 1163: ##
 1164: ## &sqltime($timestamp)
 1165: ##
 1166: ## Convert perl $timestamp to MySQL time.  MySQL expects YYYY-MM-DD HH:MM:SS
 1167: ##
 1168: sub sqltime {
 1169:     my ($time) = @_;
 1170:     my $mysqltime;
 1171:     if ($time =~
 1172:         /(\d+)-(\d+)-(\d+) # YYYY-MM-DD
 1173:         \s                 # a space
 1174:         (\d+):(\d+):(\d+)  # HH:MM::SS
 1175:         /x ) {
 1176:         # Some of the .meta files have the time in mysql
 1177:         # format already, so just make sure they are 0 padded and
 1178:         # pass them back.
 1179:         $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
 1180:                              $1,$2,$3,$4,$5,$6);
 1181:     } elsif ($time =~ /^\d+$/) {
 1182:         my @TimeData = gmtime($time);
 1183:         # Alter the month to be 1-12 instead of 0-11
 1184:         $TimeData[4]++;
 1185:         # Alter the year to be from 0 instead of from 1900
 1186:         $TimeData[5]+=1900;
 1187:         $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
 1188:                              @TimeData[5,4,3,2,1,0]);
 1189:     } elsif (! defined($time) || $time == 0) {
 1190:         $mysqltime = 0;
 1191:     } else {
 1192:         &log(0,"    sqltime:Unable to decode time ".$time);
 1193:         $mysqltime = 0;
 1194:     }
 1195:     return $mysqltime;
 1196: }
 1197: 
 1198: ######################################################################
 1199: ######################################################################
 1200: ##
 1201: ## The usual suspects, repeated here to reduce dependency hell
 1202: ##
 1203: ######################################################################
 1204: ######################################################################
 1205: sub unescape {
 1206:     my $str=shift;
 1207:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
 1208:     return $str;
 1209: }
 1210: 
 1211: sub escape {
 1212:     my $str=shift;
 1213:     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
 1214:     return $str;
 1215: }
 1216: 
 1217: 1;
 1218: 
 1219: __END__;
 1220: 
 1221: =pod
 1222: 
 1223: =back
 1224: 
 1225: =cut

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