1: #!/usr/bin/perl
2: # The LearningOnline Network
3: # searchcat.pl "Search Catalog" batch script
4: #
5: # $Id: searchcat.pl,v 1.56 2004/04/09 22:04:53 matthew Exp $
6: #
7: # Copyright Michigan State University Board of Trustees
8: #
9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
10: #
11: # LON-CAPA is free software; you can redistribute it and/or modify
12: # it under the terms of the GNU General Public License as published by
13: # the Free Software Foundation; either version 2 of the License, or
14: # (at your option) any later version.
15: #
16: # LON-CAPA is distributed in the hope that it will be useful,
17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19: # GNU General Public License for more details.
20: #
21: # You should have received a copy of the GNU General Public License
22: # along with LON-CAPA; if not, write to the Free Software
23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
24: #
25: # /home/httpd/html/adm/gpl.txt
26: #
27: # http://www.lon-capa.org/
28: #
29: ###
30:
31: =pod
32:
33: =head1 NAME
34:
35: B<searchcat.pl> - put authoritative filesystem data into sql database.
36:
37: =head1 SYNOPSIS
38:
39: Ordinarily this script is to be called from a loncapa cron job
40: (CVS source location: F<loncapa/loncom/cron/loncapa>; typical
41: filesystem installation location: F</etc/cron.d/loncapa>).
42:
43: Here is the cron job entry.
44:
45: C<# Repopulate and refresh the metadata database used for the search catalog.>
46: C<10 1 * * 7 www /home/httpd/perl/searchcat.pl>
47:
48: This script only allows itself to be run as the user C<www>.
49:
50: =head1 DESCRIPTION
51:
52: This script goes through a loncapa resource directory and gathers metadata.
53: The metadata is entered into a SQL database.
54:
55: This script also does general database maintenance such as reformatting
56: the C<loncapa:metadata> table if it is deprecated.
57:
58: This script evaluates dynamic metadata from the authors'
59: F<nohist_resevaldata.db> database file in order to store it in MySQL.
60:
61: This script is playing an increasingly important role for a loncapa
62: library server. The proper operation of this script is critical for a smooth
63: and correct user experience.
64:
65: =cut
66:
67: use strict;
68:
69: use DBI;
70: use lib '/home/httpd/lib/perl/';
71: use LONCAPA::Configuration;
72: use LONCAPA::lonmetadata;
73:
74: use Getopt::Long;
75: use IO::File;
76: use HTML::TokeParser;
77: use GDBM_File;
78: use POSIX qw(strftime mktime);
79:
80: use File::Find;
81:
82: #
83: # Set up configuration options
84: my ($simulate,$oneuser,$help,$verbose,$logfile,$debug);
85: GetOptions (
86: 'help' => \$help,
87: 'simulate' => \$simulate,
88: 'only=s' => \$oneuser,
89: 'verbose=s' => \$verbose,
90: 'debug' => \$debug,
91: );
92:
93: if ($help) {
94: print <<"ENDHELP";
95: $0
96: Rebuild and update the LON-CAPA metadata database.
97: Options:
98: -help Print this help
99: -simulate Do not modify the database.
100: -only=user Only compute for the given user. Implies -simulate
101: -verbose=val Sets logging level, val must be a number
102: -debug Turns on debugging output
103: ENDHELP
104: exit 0;
105: }
106:
107: if (! defined($debug)) {
108: $debug = 0;
109: }
110:
111: if (! defined($verbose)) {
112: $verbose = 0;
113: }
114:
115: if (defined($oneuser)) {
116: $simulate=1;
117: }
118:
119: ##
120: ## Use variables for table names so we can test this routine a little easier
121: my $oldname = 'metadata';
122: my $newname = 'newmetadata';
123:
124: #
125: # Read loncapa_apache.conf and loncapa.conf
126: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
127: my %perlvar=%{$perlvarref};
128: undef $perlvarref;
129: delete $perlvar{'lonReceipt'}; # remove since sensitive (really?) & not needed
130: #
131: # Only run if machine is a library server
132: exit if ($perlvar{'lonRole'} ne 'library');
133: #
134: # Make sure this process is running from user=www
135: my $wwwid=getpwnam('www');
136: if ($wwwid!=$<) {
137: my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
138: my $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
139: system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\
140: mailto $emailto -s '$subj' > /dev/null");
141: exit 1;
142: }
143: #
144: # Let people know we are running
145: open(LOG,'>'.$perlvar{'lonDaemons'}.'/logs/searchcat.log');
146: &log(0,'==== Searchcat Run '.localtime()."====");
147: if ($debug) {
148: &log(0,'simulating') if ($simulate);
149: &log(0,'only processing user '.$oneuser) if ($oneuser);
150: &log(0,'verbosity level = '.$verbose);
151: }
152: #
153: # Connect to database
154: my $dbh;
155: if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},
156: { RaiseError =>0,PrintError=>0}))) {
157: &log(0,"Cannot connect to database!");
158: die "MySQL Error: Cannot connect to database!\n";
159: }
160: # This can return an error and still be okay, so we do not bother checking.
161: # (perhaps it should be more robust and check for specific errors)
162: $dbh->do('DROP TABLE IF EXISTS '.$newname);
163: #
164: # Create the new table
165: my $request = &LONCAPA::lonmetadata::create_metadata_storage($newname);
166: $dbh->do($request);
167: if ($dbh->err) {
168: $dbh->disconnect();
169: &log(0,"MySQL Error Create: ".$dbh->errstr);
170: die $dbh->errstr;
171: }
172: #
173: # find out which users we need to examine
174: my $dom = $perlvar{'lonDefDomain'};
175: opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$dom");
176: my @homeusers =
177: grep {
178: &ishome("$perlvar{'lonDocRoot'}/res/$dom/$_");
179: } grep {
180: !/^\.\.?$/;
181: } readdir(RESOURCES);
182: closedir RESOURCES;
183: #
184: if ($oneuser) {
185: @homeusers=($oneuser);
186: }
187: #
188: # Loop through the users
189: foreach my $user (@homeusers) {
190: &log(0,"=== User: ".$user);
191: &process_dynamic_metadata($user,$dom);
192: #
193: # Use File::Find to get the files we need to read/modify
194: find(
195: {preprocess => \&only_meta_files,
196: # wanted => \&print_filename,
197: # wanted => \&log_metadata,
198: wanted => \&process_meta_file,
199: },
200: "$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");
201: }
202: #
203: # Rename the table
204: if (! $simulate) {
205: $dbh->do('DROP TABLE IF EXISTS '.$oldname);
206: if (! $dbh->do('RENAME TABLE '.$newname.' TO '.$oldname)) {
207: &log(0,"MySQL Error Rename: ".$dbh->errstr);
208: die $dbh->errstr;
209: } else {
210: &log(1,"MySQL table rename successful.");
211: }
212: }
213:
214: if (! $dbh->disconnect) {
215: &log(0,"MySQL Error Disconnect: ".$dbh->errstr);
216: die $dbh->errstr;
217: }
218: ##
219: ## Finished!
220: &log(0,"==== Searchcat completed ".localtime()." ====");
221: close(LOG);
222:
223: &write_type_count();
224: &write_copyright_count();
225:
226: exit 0;
227:
228: ##
229: ## Status logging routine. Inputs: $level, $message
230: ##
231: ## $level 0 should be used for normal output and error messages
232: ##
233: ## $message does not need to end with \n. In the case of errors
234: ## the message should contain as much information as possible to
235: ## help in diagnosing the problem.
236: ##
237: sub log {
238: my ($level,$message)=@_;
239: $level = 0 if (! defined($level));
240: if ($verbose >= $level) {
241: print LOG $message.$/;
242: }
243: }
244:
245: ########################################################
246: ########################################################
247: ### ###
248: ### File::Find support routines ###
249: ### ###
250: ########################################################
251: ########################################################
252: ##
253: ## &only_meta_files
254: ##
255: ## Called by File::Find.
256: ## Takes a list of files/directories in and returns a list of files/directories
257: ## to search.
258: sub only_meta_files {
259: my @PossibleFiles = @_;
260: my @ChosenFiles;
261: foreach my $file (@PossibleFiles) {
262: if ( ($file =~ /\.meta$/ && # Ends in meta
263: $file !~ /\.\d+\.[^\.]+\.meta$/ # is not for a prior version
264: ) || (-d $file )) { # directories are okay
265: # but we do not want /. or /..
266: push(@ChosenFiles,$file);
267: }
268: }
269: return @ChosenFiles;
270: }
271:
272: ##
273: ##
274: ## Debugging routines, use these for 'wanted' in the File::Find call
275: ##
276: sub print_filename {
277: my ($file) = $_;
278: my $fullfilename = $File::Find::name;
279: if ($debug) {
280: if (-d $file) {
281: &log(5," Got directory ".$fullfilename);
282: } else {
283: &log(5," Got file ".$fullfilename);
284: }
285: }
286: $_=$file;
287: }
288:
289: sub log_metadata {
290: my ($file) = $_;
291: my $fullfilename = $File::Find::name;
292: return if (-d $fullfilename); # No need to do anything here for directories
293: if ($debug) {
294: &log(6,$fullfilename);
295: my $ref=&metadata($fullfilename);
296: if (! defined($ref)) {
297: &log(6," No data");
298: return;
299: }
300: while (my($key,$value) = each(%$ref)) {
301: &log(6," ".$key." => ".$value);
302: }
303: &count_copyright($ref->{'copyright'});
304: }
305: $_=$file;
306: }
307:
308:
309: ##
310: ## process_meta_file
311: ## Called by File::Find.
312: ## Only input is the filename in $_.
313: sub process_meta_file {
314: my ($file) = $_;
315: my $filename = $File::Find::name; # full filename
316: return if (-d $filename); # No need to do anything here for directories
317: #
318: &log(3,$filename) if ($debug);
319: #
320: my $ref=&metadata($filename);
321: #
322: # $url is the original file url, not the metadata file
323: my $url='/res/'.&declutter($filename);
324: $url=~s/\.meta$//;
325: &log(3," ".$url) if ($debug);
326: #
327: # Ignore some files based on their metadata
328: if ($ref->{'obsolete'}) {
329: &log(3,"obsolete") if ($debug);
330: return;
331: }
332: &count_copyright($ref->{'copyright'});
333: if ($ref->{'copyright'} eq 'private') {
334: &log(3,"private") if ($debug);
335: return;
336: }
337: #
338: # Find the dynamic metadata
339: my %dyn;
340: if ($url=~ m:/default$:) {
341: $url=~ s:/default$:/:;
342: &log(3,"Skipping dynamic data") if ($debug);
343: } else {
344: &log(3,"Retrieving dynamic data") if ($debug);
345: %dyn=&get_dynamic_metadata($url);
346: &count_type($url);
347: }
348: #
349: $ref->{'creationdate'} = &sqltime($ref->{'creationdate'});
350: $ref->{'lastrevisiondate'} = &sqltime($ref->{'lastrevisiondate'});
351: my %Data = (
352: %$ref,
353: %dyn,
354: 'url'=>$url,
355: 'version'=>'current');
356: if (! $simulate) {
357: my ($count,$err) = &LONCAPA::lonmetadata::store_metadata($dbh,$newname,
358: \%Data);
359: if ($err) {
360: &log(0,"MySQL Error Insert: ".$err);
361: die $err;
362: }
363: if ($count < 1) {
364: &log(0,"Unable to insert record into MySQL database for $url");
365: die "Unable to insert record into MySQl database for $url";
366: }
367: }
368: #
369: # Reset $_ before leaving
370: $_ = $file;
371: }
372:
373: ########################################################
374: ########################################################
375: ### ###
376: ### &metadata($uri) ###
377: ### Retrieve metadata for the given file ###
378: ### ###
379: ########################################################
380: ########################################################
381: sub metadata {
382: my ($uri)=@_;
383: my %metacache=();
384: $uri=&declutter($uri);
385: my $filename=$uri;
386: $uri=~s/\.meta$//;
387: $uri='';
388: if ($filename !~ /\.meta$/) {
389: $filename.='.meta';
390: }
391: my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);
392: return undef if (! defined($metastring));
393: my $parser=HTML::TokeParser->new(\$metastring);
394: my $token;
395: while ($token=$parser->get_token) {
396: if ($token->[0] eq 'S') {
397: my $entry=$token->[1];
398: my $unikey=$entry;
399: if (defined($token->[2]->{'part'})) {
400: $unikey.='_'.$token->[2]->{'part'};
401: }
402: if (defined($token->[2]->{'name'})) {
403: $unikey.='_'.$token->[2]->{'name'};
404: }
405: if ($metacache{$uri.'keys'}) {
406: $metacache{$uri.'keys'}.=','.$unikey;
407: } else {
408: $metacache{$uri.'keys'}=$unikey;
409: }
410: foreach ( @{$token->[3]}) {
411: $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_};
412: }
413: if (! ($metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry))){
414: $metacache{$uri.''.$unikey} =
415: $metacache{$uri.''.$unikey.'.default'};
416: }
417: } # End of ($token->[0] eq 'S')
418: }
419: return \%metacache;
420: }
421:
422: ##
423: ## &getfile($filename)
424: ## Slurps up an entire file into a scalar.
425: ## Returns undef if the file does not exist
426: sub getfile {
427: my $file = shift();
428: if (! -e $file ) {
429: return undef;
430: }
431: my $fh=IO::File->new($file);
432: my $contents = '';
433: while (<$fh>) {
434: $contents .= $_;
435: }
436: return $contents;
437: }
438:
439: ########################################################
440: ########################################################
441: ### ###
442: ### Dynamic Metadata ###
443: ### ###
444: ########################################################
445: ########################################################
446: ##
447: ## Dynamic metadata description
448: ##
449: ## Field Type
450: ##-----------------------------------------------------------
451: ## count integer
452: ## course integer
453: ## course_list comma seperated list of course ids
454: ## avetries real
455: ## avetries_list comma seperated list of real numbers
456: ## stdno real
457: ## stdno_list comma seperated list of real numbers
458: ## usage integer
459: ## usage_list comma seperated list of resources
460: ## goto scalar
461: ## goto_list comma seperated list of resources
462: ## comefrom scalar
463: ## comefrom_list comma seperated list of resources
464: ## difficulty real
465: ## difficulty_list comma seperated list of real numbers
466: ## sequsage scalar
467: ## sequsage_list comma seperated list of resources
468: ## clear real
469: ## technical real
470: ## correct real
471: ## helpful real
472: ## depth real
473: ## comments html of all the comments made
474: ##
475: {
476:
477: my %DynamicData;
478: my %Counts;
479:
480: sub process_dynamic_metadata {
481: my ($user,$dom) = @_;
482: undef(%DynamicData);
483: undef(%Counts);
484: #
485: my $prodir = &propath($dom,$user);
486: #
487: # Read in the dynamic metadata
488: my %evaldata;
489: if (! tie(%evaldata,'GDBM_File',
490: $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) {
491: return 0;
492: }
493: #
494: # Process every stored element
495: while (my ($storedkey,$value) = each(%evaldata)) {
496: my ($source,$file,$type) = split('___',$storedkey);
497: $source = &unescape($source);
498: $file = &unescape($file);
499: $value = &unescape($value);
500: " got ".$file."\n ".$type." ".$source."\n";
501: if ($type =~ /^(avetries|count|difficulty|stdno|timestamp)$/) {
502: #
503: # Statistics: $source is course id
504: $DynamicData{$file}->{'statistics'}->{$source}->{$type}=$value;
505: } elsif ($type =~ /^(clear|comments|depth|technical|helpful)$/){
506: #
507: # Evaluation $source is username, check if they evaluated it
508: # more than once. If so, pad the entry with a space.
509: while(exists($DynamicData{$file}->{'evaluation'}->{$type}->{$source})) {
510: $source .= ' ';
511: }
512: $DynamicData{$file}->{'evaluation'}->{$type}->{$source}=$value;
513: } elsif ($type =~ /^(course|comefrom|goto|usage)$/) {
514: #
515: # Context $source is course id or resource
516: push(@{$DynamicData{$file}->{$type}},&unescape($source));
517: } else {
518: &log(0," ".$user."@".$dom.":Process metadata: Unable to decode ".$type);
519: }
520: }
521: untie(%evaldata);
522: #
523: # Read in the access count data
524: &log(7,'Reading access count data') if ($debug);
525: my %countdata;
526: if (! tie(%countdata,'GDBM_File',
527: $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) {
528: return 0;
529: }
530: while (my ($key,$count) = each(%countdata)) {
531: next if ($key !~ /^$dom/);
532: $key = &unescape($key);
533: &log(8,' Count '.$key.' = '.$count) if ($debug);
534: $Counts{$key}=$count;
535: }
536: untie(%countdata);
537: if ($debug) {
538: &log(7,scalar(keys(%Counts)).
539: " Counts read for ".$user."@".$dom);
540: &log(7,scalar(keys(%DynamicData)).
541: " Dynamic metadata read for ".$user."@".$dom);
542: }
543: #
544: return 1;
545: }
546:
547: sub get_dynamic_metadata {
548: my ($url) = @_;
549: $url =~ s:^/res/::;
550: if (! exists($DynamicData{$url})) {
551: &log(7,' No dynamic data for '.$url) if ($debug);
552: return ();
553: }
554: my %data;
555: my $resdata = $DynamicData{$url};
556: #
557: # Get the statistical data
558: foreach my $type (qw/avetries difficulty stdno/) {
559: my $count;
560: my $sum;
561: my @Values;
562: foreach my $coursedata (values(%{$resdata->{'statistics'}})) {
563: if (ref($coursedata) eq 'HASH' && exists($coursedata->{$type})) {
564: $count++;
565: $sum += $coursedata->{$type};
566: push(@Values,$coursedata->{$type});
567: }
568: }
569: if ($count) {
570: $data{$type} = $sum/$count;
571: $data{$type.'_list'} = join(',',@Values);
572: }
573: }
574: # find the count
575: $data{'count'} = $Counts{$url};
576: #
577: # Get the context data
578: foreach my $type (qw/course goto comefrom/) {
579: if (defined($resdata->{$type}) &&
580: ref($resdata->{$type}) eq 'ARRAY') {
581: $data{$type} = scalar(@{$resdata->{$type}});
582: $data{$type.'_list'} = join(',',@{$resdata->{$type}});
583: }
584: }
585: if (defined($resdata->{'usage'}) &&
586: ref($resdata->{'usage'}) eq 'ARRAY') {
587: $data{'sequsage'} = scalar(@{$resdata->{'usage'}});
588: $data{'sequsage_list'} = join(',',@{$resdata->{'usage'}});
589: }
590: #
591: # Get the evaluation data
592: foreach my $type (qw/clear technical correct helpful depth/) {
593: my $count;
594: my $sum;
595: foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{$type}})){
596: $sum += $resdata->{'evaluation'}->{$type}->{$evaluator};
597: $count++;
598: }
599: if ($count > 0) {
600: $data{$type}=$sum/$count;
601: }
602: }
603: #
604: # put together comments
605: my $comments = '<div class="LCevalcomments">';
606: foreach my $evaluator (keys(%{$resdata->{'evaluation'}->{'comments'}})){
607: $comments .= $evaluator.':'.
608: $resdata->{'evaluation'}->{'comments'}->{$evaluator}.'<hr />';
609: }
610: $comments .= '</div>';
611: #
612: # Log the dynamic metadata
613: if ($debug) {
614: while (my($k,$v)=each(%data)) {
615: &log(8," ".$k." => ".$v);
616: }
617: }
618: #
619: return %data;
620: }
621:
622: } # End of %DynamicData and %Counts scope
623:
624: ########################################################
625: ########################################################
626: ### ###
627: ### Counts ###
628: ### ###
629: ########################################################
630: ########################################################
631: {
632:
633: my %countext;
634:
635: sub count_type {
636: my $file=shift;
637: $file=~/\.(\w+)$/;
638: my $ext=lc($1);
639: $countext{$ext}++;
640: }
641:
642: sub write_type_count {
643: open(RESCOUNT,'>/home/httpd/html/lon-status/rescount.txt');
644: while (my ($extension,$count) = each(%countext)) {
645: print RESCOUNT $extension.'='.$count.'&';
646: }
647: print RESCOUNT 'time='.time."\n";
648: close(RESCOUNT);
649: }
650:
651: } # end of scope for %countext
652:
653: {
654:
655: my %copyrights;
656:
657: sub count_copyright {
658: $copyrights{@_[0]}++;
659: }
660:
661: sub write_copyright_count {
662: open(COPYCOUNT,'>/home/httpd/html/lon-status/copyrightcount.txt');
663: while (my ($copyright,$count) = each(%copyrights)) {
664: print COPYCOUNT $copyright.'='.$count.'&';
665: }
666: print COPYCOUNT 'time='.time."\n";
667: close(COPYCOUNT);
668: }
669:
670: } # end of scope for %copyrights
671:
672: ########################################################
673: ########################################################
674: ### ###
675: ### Miscellanous Utility Routines ###
676: ### ###
677: ########################################################
678: ########################################################
679: ##
680: ## &ishome($username)
681: ## Returns 1 if $username is a LON-CAPA author, 0 otherwise
682: ## (copied from lond, modification of the return value)
683: sub ishome {
684: my $author=shift;
685: $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
686: my ($udom,$uname)=split(/\//,$author);
687: my $proname=propath($udom,$uname);
688: if (-e $proname) {
689: return 1;
690: } else {
691: return 0;
692: }
693: }
694:
695: ##
696: ## &propath($udom,$uname)
697: ## Returns the path to the users LON-CAPA directory
698: ## (copied from lond)
699: sub propath {
700: my ($udom,$uname)=@_;
701: $udom=~s/\W//g;
702: $uname=~s/\W//g;
703: my $subdir=$uname.'__';
704: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
705: my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
706: return $proname;
707: }
708:
709: ##
710: ## &sqltime($timestamp)
711: ##
712: ## Convert perl $timestamp to MySQL time. MySQL expects YYYY-MM-DD HH:MM:SS
713: ##
714: sub sqltime {
715: my ($time) = @_;
716: my $mysqltime;
717: if ($time =~
718: /(\d+)-(\d+)-(\d+) # YYYY-MM-DD
719: \s # a space
720: (\d+):(\d+):(\d+) # HH:MM::SS
721: /x ) {
722: # Some of the .meta files have the time in mysql
723: # format already, so just make sure they are 0 padded and
724: # pass them back.
725: $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
726: $1,$2,$3,$4,$5,$6);
727: } elsif ($time =~ /^\d+$/) {
728: my @TimeData = gmtime($time);
729: # Alter the month to be 1-12 instead of 0-11
730: $TimeData[4]++;
731: # Alter the year to be from 0 instead of from 1900
732: $TimeData[5]+=1900;
733: $mysqltime = sprintf('%04d-%02d-%02d %02d:%02d:%02d',
734: @TimeData[5,4,3,2,1,0]);
735: } elsif (! defined($time) || $time == 0) {
736: $mysqltime = 0;
737: } else {
738: &log(0," sqltime:Unable to decode time ".$time);
739: $mysqltime = 0;
740: }
741: return $mysqltime;
742: }
743:
744: ##
745: ## &declutter($filename)
746: ## Given a filename, returns a url for the filename.
747: sub declutter {
748: my $thisfn=shift;
749: $thisfn=~s/^$perlvar{'lonDocRoot'}//;
750: $thisfn=~s/^\///;
751: $thisfn=~s/^res\///;
752: return $thisfn;
753: }
754:
755: ##
756: ## Escape / Unescape special characters
757: sub unescape {
758: my $str=shift;
759: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
760: return $str;
761: }
762:
763: sub escape {
764: my $str=shift;
765: $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
766: return $str;
767: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to searchcat.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / metadata_database