loncom/metadata_database/searchcat.pl - view

File: [LON-CAPA] / loncom / metadata_database / searchcat.pl
Revision 1.78: download - view: text, annotated - select for diffs
Fri Mar 26 13:29:31 2010 UTC (14 years, 1 month ago) by raeburn
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_1, version_2_9_0, version_2_8_99_1, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, PRINT_INCOMPLETE_base, PRINT_INCOMPLETE, HEAD, BZ4492-merge, BZ4492-feature_horizontal_radioresponse

- When populating allusers table:
  - Use hash of courseIDs from single call to lonnet::courseiddump() for domain, instead of individual call to lonnet::is_course() to test if user is a course.
  - Check if directory in lonUsers/$dom/$1/$2/$3/$uname is for a user
    by testing for existence of passwd file.

1: #!/usr/bin/perl 2: # The LearningOnline Network 3: # searchcat.pl "Search Catalog" batch script 4: # 5: # $Id: searchcat.pl,v 1.78 2010/03/26 13:29:31 raeburn 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: use DBI; 69: use lib '/home/httpd/lib/perl/'; 70: use LONCAPA::lonmetadata; 71: use LONCAPA; 72: use Getopt::Long; 73: use IO::File; 74: use HTML::TokeParser; 75: use GDBM_File; 76: use POSIX qw(strftime mktime); 77: 78: use Apache::lonnet(); 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 %oldnames = ( 122: 'metadata' => 'metadata', 123: 'portfolio' => 'portfolio_metadata', 124: 'access' => 'portfolio_access', 125: 'addedfields' => 'portfolio_addedfields', 126: 'allusers' => 'allusers', 127: ); 128: 129: my %newnames; 130: # new table names - append pid to have unique temporary tables 131: foreach my $key (keys(%oldnames)) { 132: $newnames{$key} = 'new'.$oldnames{$key}.$$; 133: } 134: 135: # 136: # Only run if machine is a library server 137: exit if ($Apache::lonnet::perlvar{'lonRole'} ne 'library'); 138: my $hostid = $Apache::lonnet::perlvar{'lonHostID'}; 139: 140: # 141: # Make sure this process is running from user=www 142: my $wwwid=getpwnam('www'); 143: if ($wwwid!=$<) { 144: my $emailto="$Apache::lonnet::perlvar{'lonAdmEMail'},$Apache::lonnet::perlvar{'lonSysEMail'}"; 145: my $subj="LON: $Apache::lonnet::perlvar{'lonHostID'} User ID mismatch"; 146: system("echo 'User ID mismatch. searchcat.pl must be run as user www.' |\ 147: mail -s '$subj' $emailto > /dev/null"); 148: exit 1; 149: } 150: # 151: # Let people know we are running 152: open(LOG,'>>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/logs/searchcat.log'); 153: &log(0,'==== Searchcat Run '.localtime()."===="); 154: 155: 156: if ($debug) { 157: &log(0,'simulating') if ($simulate); 158: &log(0,'only processing user '.$oneuser) if ($oneuser); 159: &log(0,'verbosity level = '.$verbose); 160: } 161: # 162: # Connect to database 163: my $dbh; 164: if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",$Apache::lonnet::perlvar{'lonSqlAccess'}, 165: { RaiseError =>0,PrintError=>0}))) { 166: &log(0,"Cannot connect to database!"); 167: die "MySQL Error: Cannot connect to database!\n"; 168: } 169: # This can return an error and still be okay, so we do not bother checking. 170: # (perhaps it should be more robust and check for specific errors) 171: foreach my $key (keys(%newnames)) { 172: if ($newnames{$key} ne '') { 173: $dbh->do('DROP TABLE IF EXISTS '.$newnames{$key}); 174: } 175: } 176: 177: # 178: # Create the new metadata, portfolio and allusers tables 179: foreach my $key (keys(%newnames)) { 180: if ($newnames{$key} ne '') { 181: my $request = 182: &LONCAPA::lonmetadata::create_metadata_storage($newnames{$key},$oldnames{$key}); 183: $dbh->do($request); 184: if ($dbh->err) { 185: $dbh->disconnect(); 186: &log(0,"MySQL Error Create: ".$dbh->errstr); 187: die $dbh->errstr; 188: } 189: } 190: } 191: 192: # 193: # find out which users we need to examine 194: my @domains = sort(&Apache::lonnet::current_machine_domains()); 195: &log(9,'domains ="'.join('","',@domains).'"'); 196: 197: foreach my $dom (@domains) { 198: &log(9,'domain = '.$dom); 199: opendir(RESOURCES,"$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom"); 200: my @homeusers = 201: grep { 202: &ishome("$Apache::lonnet::perlvar{'lonDocRoot'}/res/$dom/$_"); 203: } grep { 204: !/^\.\.?$/; 205: } readdir(RESOURCES); 206: closedir RESOURCES; 207: &log(5,'users = '.$dom.':'.join(',',@homeusers)); 208: # 209: if ($oneuser) { 210: @homeusers=($oneuser); 211: } 212: # 213: # Loop through the users 214: foreach my $user (@homeusers) { 215: &log(0,"=== User: ".$user); 216: &process_dynamic_metadata($user,$dom); 217: # 218: # Use File::Find to get the files we need to read/modify 219: find( 220: {preprocess => \&only_meta_files, 221: #wanted => \&print_filename, 222: #wanted => \&log_metadata, 223: wanted => \&process_meta_file, 224: no_chdir => 1, 225: }, join('/',($Apache::lonnet::perlvar{'lonDocRoot'},'res',$dom,$user)) ); 226: } 227: # Search for all users and public portfolio files 228: my (%allusers,%portusers,%courses); 229: if ($oneuser) { 230: %portusers = ( 231: $oneuser => '', 232: ); 233: %allusers = ( 234: $oneuser => '', 235: ); 236: %courses = &courseiddump($dom,'.',1,'.','.',$oneuser,undef, 237: undef,'.'); 238: } else { 239: # get courseIDs for domain on current machine 240: %courses=&Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,[$hostid],'.'); 241: my $dir = $Apache::lonnet::perlvar{lonUsersDir}.'/'.$dom; 242: &descend_tree($dom,$dir,0,\%portusers,\%allusers); 243: } 244: foreach my $uname (keys(%portusers)) { 245: my $urlstart = '/uploaded/'.$dom.'/'.$uname; 246: my $pathstart = &propath($dom,$uname).'/userfiles'; 247: my $is_course = ''; 248: if (exists($courses{$dom.'_'.$uname})) { 249: $is_course = 1; 250: } 251: my $curr_perm = &Apache::lonnet::get_portfile_permissions($dom,$uname); 252: my %access = &Apache::lonnet::get_access_controls($curr_perm); 253: foreach my $file (keys(%access)) { 254: my ($group,$url,$fullpath); 255: if ($is_course) { 256: ($group, my ($path)) = ($file =~ /^(\w+)(\/.+)$/); 257: $fullpath = $pathstart.'/groups/'.$group.'/portfolio'.$path; 258: $url = $urlstart.'/groups/'.$group.'/portfolio'.$path; 259: } else { 260: $fullpath = $pathstart.'/portfolio'.$file; 261: $url = $urlstart.'/portfolio'.$file; 262: } 263: if (ref($access{$file}) eq 'HASH') { 264: my %portaccesslog = 265: &LONCAPA::lonmetadata::process_portfolio_access_data($dbh, 266: $simulate,\%newnames,$url,$fullpath,$access{$file}); 267: &portfolio_logging(%portaccesslog); 268: } 269: my %portmetalog = &LONCAPA::lonmetadata::process_portfolio_metadata($dbh,$simulate,\%newnames,$url,$fullpath,$is_course,$dom,$uname,$group); 270: &portfolio_logging(%portmetalog); 271: } 272: } 273: # Update allusers 274: foreach my $uname (keys(%allusers)) { 275: next if (exists($courses{$dom.'_'.$uname})); 276: my %userdata = 277: &Apache::lonnet::get('environment',['firstname','lastname', 278: 'middlename','generation','id','permanentemail'],$dom,$uname); 279: $userdata{'username'} = $uname; 280: $userdata{'domain'} = $dom; 281: my %alluserslog = 282: &LONCAPA::lonmetadata::process_allusers_data($dbh,$simulate, 283: \%newnames,$uname,$dom,\%userdata); 284: foreach my $item (keys(%alluserslog)) { 285: &log(0,$alluserslog{$item}); 286: } 287: } 288: } 289: 290: # 291: # Rename the tables 292: if (! $simulate) { 293: foreach my $key (keys(%oldnames)) { 294: if (($oldnames{$key} ne '') && ($newnames{$key} ne '')) { 295: $dbh->do('DROP TABLE IF EXISTS '.$oldnames{$key}); 296: if (! $dbh->do('RENAME TABLE '.$newnames{$key}.' TO '.$oldnames{$key})) { 297: &log(0,"MySQL Error Rename: ".$dbh->errstr); 298: die $dbh->errstr; 299: } else { 300: &log(1,"MySQL table rename successful for $key."); 301: } 302: } 303: } 304: } 305: if (! $dbh->disconnect) { 306: &log(0,"MySQL Error Disconnect: ".$dbh->errstr); 307: die $dbh->errstr; 308: } 309: ## 310: ## Finished! 311: &log(0,"==== Searchcat completed ".localtime()." ===="); 312: close(LOG); 313: 314: &write_type_count(); 315: &write_copyright_count(); 316: 317: exit 0; 318: 319: ## 320: ## Status logging routine. Inputs: $level, $message 321: ## 322: ## $level 0 should be used for normal output and error messages 323: ## 324: ## $message does not need to end with \n. In the case of errors 325: ## the message should contain as much information as possible to 326: ## help in diagnosing the problem. 327: ## 328: sub log { 329: my ($level,$message)=@_; 330: $level = 0 if (! defined($level)); 331: if ($verbose >= $level) { 332: print LOG $message.$/; 333: } 334: } 335: 336: sub portfolio_logging { 337: my (%portlog) = @_; 338: foreach my $key (keys(%portlog)) { 339: if (ref($portlog{$key}) eq 'HASH') { 340: foreach my $item (keys(%{$portlog{$key}})) { 341: &log(0,$portlog{$key}{$item}); 342: } 343: } 344: } 345: } 346: 347: sub descend_tree { 348: my ($dom,$dir,$depth,$allportusers,$alldomusers) = @_; 349: if (-d $dir) { 350: opendir(DIR,$dir); 351: my @contents = grep(!/^\./,readdir(DIR)); 352: closedir(DIR); 353: $depth ++; 354: foreach my $item (@contents) { 355: if ($depth < 4) { 356: &descend_tree($dom,$dir.'/'.$item,$depth,$allportusers,$alldomusers); 357: } else { 358: if (-e $dir.'/'.$item.'/file_permissions.db') { 359: $$allportusers{$item} = ''; 360: } 361: if (-e $dir.'/'.$item.'/passwd') { 362: $$alldomusers{$item} = ''; 363: } 364: } 365: } 366: } 367: } 368: 369: ######################################################## 370: ######################################################## 371: ### ### 372: ### File::Find support routines ### 373: ### ### 374: ######################################################## 375: ######################################################## 376: ## 377: ## &only_meta_files 378: ## 379: ## Called by File::Find. 380: ## Takes a list of files/directories in and returns a list of files/directories 381: ## to search. 382: sub only_meta_files { 383: my @PossibleFiles = @_; 384: my @ChosenFiles; 385: foreach my $file (@PossibleFiles) { 386: if ( ($file =~ /\.meta$/ && # Ends in meta 387: $file !~ /\.\d+\.[^\.]+\.meta$/ # is not for a prior version 388: ) || (-d $File::Find::dir."/".$file )) { # directories are okay 389: # but we do not want /. or /.. 390: push(@ChosenFiles,$file); 391: } 392: } 393: return @ChosenFiles; 394: } 395: 396: ## 397: ## 398: ## Debugging routines, use these for 'wanted' in the File::Find call 399: ## 400: sub print_filename { 401: my ($file) = $_; 402: my $fullfilename = $File::Find::name; 403: if ($debug) { 404: if (-d $file) { 405: &log(5," Got directory ".$fullfilename); 406: } else { 407: &log(5," Got file ".$fullfilename); 408: } 409: } 410: $_=$file; 411: } 412: 413: sub log_metadata { 414: my ($file) = $_; 415: my $fullfilename = $File::Find::name; 416: return if (-d $fullfilename); # No need to do anything here for directories 417: if ($debug) { 418: &log(6,$fullfilename); 419: my $ref = &metadata($fullfilename); 420: if (! defined($ref)) { 421: &log(6," No data"); 422: return; 423: } 424: while (my($key,$value) = each(%$ref)) { 425: &log(6," ".$key." => ".$value); 426: } 427: &count_copyright($ref->{'copyright'}); 428: } 429: $_=$file; 430: } 431: 432: ## 433: ## process_meta_file 434: ## Called by File::Find. 435: ## Only input is the filename in $_. 436: sub process_meta_file { 437: my ($file) = $_; 438: my $filename = $File::Find::name; # full filename 439: return if (-d $filename); # No need to do anything here for directories 440: # 441: &log(3,$filename) if ($debug); 442: # 443: my $ref = &metadata($filename); 444: # 445: # $url is the original file url, not the metadata file 446: my $target = $filename; 447: $target =~ s/\.meta$//; 448: my $url='/res/'.&declutter($target); 449: &log(3," ".$url) if ($debug); 450: # 451: # Ignore some files based on their metadata 452: if ($ref->{'obsolete'}) { 453: &log(3,"obsolete") if ($debug); 454: return; 455: } 456: &count_copyright($ref->{'copyright'}); 457: if ($ref->{'copyright'} eq 'private') { 458: &log(3,"private") if ($debug); 459: return; 460: } 461: # 462: # Find the dynamic metadata 463: my %dyn; 464: if ($url=~ m:/default$:) { 465: $url=~ s:/default$:/:; 466: &log(3,"Skipping dynamic data") if ($debug); 467: } else { 468: &log(3,"Retrieving dynamic data") if ($debug); 469: %dyn=&get_dynamic_metadata($url); 470: &count_type($url); 471: } 472: &LONCAPA::lonmetadata::getfiledates($ref,$target); 473: # 474: my %Data = ( 475: %$ref, 476: %dyn, 477: 'url'=>$url, 478: 'version'=>'current'); 479: if (! $simulate) { 480: my ($count,$err) = 481: &LONCAPA::lonmetadata::store_metadata($dbh,$newnames{'metadata'}, 482: 'metadata',\%Data); 483: if ($err) { 484: &log(0,"MySQL Error Insert: ".$err); 485: } 486: if ($count < 1) { 487: &log(0,"Unable to insert record into MySQL database for $url"); 488: } 489: } 490: # 491: # Reset $_ before leaving 492: $_ = $file; 493: } 494: 495: ######################################################## 496: ######################################################## 497: ### ### 498: ### &metadata($uri) ### 499: ### Retrieve metadata for the given file ### 500: ### ### 501: ######################################################## 502: ######################################################## 503: sub metadata { 504: my ($uri) = @_; 505: my %metacache=(); 506: $uri=&declutter($uri); 507: my $filename=$uri; 508: $uri=~s/\.meta$//; 509: $uri=''; 510: if ($filename !~ /\.meta$/) { 511: $filename.='.meta'; 512: } 513: my $metastring = 514: &LONCAPA::lonmetadata::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$filename); 515: return undef if (! defined($metastring)); 516: my $parser=HTML::TokeParser->new(\$metastring); 517: my $token; 518: while ($token=$parser->get_token) { 519: if ($token->[0] eq 'S') { 520: my $entry=$token->[1]; 521: my $unikey=$entry; 522: if (defined($token->[2]->{'part'})) { 523: $unikey.='_'.$token->[2]->{'part'}; 524: } 525: if (defined($token->[2]->{'name'})) { 526: $unikey.='_'.$token->[2]->{'name'}; 527: } 528: if ($metacache{$uri.'keys'}) { 529: $metacache{$uri.'keys'}.=','.$unikey; 530: } else { 531: $metacache{$uri.'keys'}=$unikey; 532: } 533: foreach ( @{$token->[3]}) { 534: $metacache{$uri.''.$unikey.'.'.$_}=$token->[2]->{$_}; 535: } 536: if (! ($metacache{$uri.''.$unikey}=$parser->get_text('/'.$entry))){ 537: $metacache{$uri.''.$unikey} = 538: $metacache{$uri.''.$unikey.'.default'}; 539: } 540: } # End of ($token->[0] eq 'S') 541: } 542: return \%metacache; 543: } 544: 545: ######################################################## 546: ######################################################## 547: ### ### 548: ### Dynamic Metadata ### 549: ### ### 550: ######################################################## 551: ######################################################## 552: ## 553: ## Dynamic metadata description (incomplete) 554: ## 555: ## For a full description of all fields, 556: ## see LONCAPA::lonmetadata 557: ## 558: ## Field Type 559: ##----------------------------------------------------------- 560: ## count integer 561: ## course integer 562: ## course_list comma separated list of course ids 563: ## avetries real 564: ## avetries_list comma separated list of real numbers 565: ## stdno real 566: ## stdno_list comma separated list of real numbers 567: ## usage integer 568: ## usage_list comma separated list of resources 569: ## goto scalar 570: ## goto_list comma separated list of resources 571: ## comefrom scalar 572: ## comefrom_list comma separated list of resources 573: ## difficulty real 574: ## difficulty_list comma separated list of real numbers 575: ## sequsage scalar 576: ## sequsage_list comma separated list of resources 577: ## clear real 578: ## technical real 579: ## correct real 580: ## helpful real 581: ## depth real 582: ## comments html of all the comments made 583: ## 584: { 585: 586: my %DynamicData; 587: my %Counts; 588: 589: sub process_dynamic_metadata { 590: my ($user,$dom) = @_; 591: undef(%DynamicData); 592: undef(%Counts); 593: # 594: my $prodir = &propath($dom,$user); 595: # 596: # Read in the dynamic metadata 597: my %evaldata; 598: if (! tie(%evaldata,'GDBM_File', 599: $prodir.'/nohist_resevaldata.db',&GDBM_READER(),0640)) { 600: return 0; 601: } 602: # 603: %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata); 604: untie(%evaldata); 605: $DynamicData{'domain'} = $dom; 606: #print('user = '.$user.' domain = '.$dom.$/); 607: # 608: # Read in the access count data 609: &log(7,'Reading access count data') if ($debug); 610: my %countdata; 611: if (! tie(%countdata,'GDBM_File', 612: $prodir.'/nohist_accesscount.db',&GDBM_READER(),0640)) { 613: return 0; 614: } 615: while (my ($key,$count) = each(%countdata)) { 616: next if ($key !~ /^$dom/); 617: $key = &unescape($key); 618: &log(8,' Count '.$key.' = '.$count) if ($debug); 619: $Counts{$key}=$count; 620: } 621: untie(%countdata); 622: if ($debug) { 623: &log(7,scalar(keys(%Counts)). 624: " Counts read for ".$user."@".$dom); 625: &log(7,scalar(keys(%DynamicData)). 626: " Dynamic metadata read for ".$user."@".$dom); 627: } 628: # 629: return 1; 630: } 631: 632: sub get_dynamic_metadata { 633: my ($url) = @_; 634: $url =~ s:^/res/::; 635: my %data = &LONCAPA::lonmetadata::process_dynamic_metadata($url, 636: \%DynamicData); 637: # find the count 638: $data{'count'} = $Counts{$url}; 639: # 640: # Log the dynamic metadata 641: if ($debug) { 642: while (my($k,$v)=each(%data)) { 643: &log(8," ".$k." => ".$v); 644: } 645: } 646: return %data; 647: } 648: 649: } # End of %DynamicData and %Counts scope 650: 651: ######################################################## 652: ######################################################## 653: ### ### 654: ### Counts ### 655: ### ### 656: ######################################################## 657: ######################################################## 658: { 659: 660: my %countext; 661: 662: sub count_type { 663: my $file=shift; 664: $file=~/\.(\w+)$/; 665: my $ext=lc($1); 666: $countext{$ext}++; 667: } 668: 669: sub write_type_count { 670: open(RESCOUNT,'>/home/httpd/html/lon-status/rescount.txt'); 671: while (my ($extension,$count) = each(%countext)) { 672: print RESCOUNT $extension.'='.$count.'&'; 673: } 674: print RESCOUNT 'time='.time."\n"; 675: close(RESCOUNT); 676: } 677: 678: } # end of scope for %countext 679: 680: { 681: 682: my %copyrights; 683: 684: sub count_copyright { 685: $copyrights{@_[0]}++; 686: } 687: 688: sub write_copyright_count { 689: open(COPYCOUNT,'>/home/httpd/html/lon-status/copyrightcount.txt'); 690: while (my ($copyright,$count) = each(%copyrights)) { 691: print COPYCOUNT $copyright.'='.$count.'&'; 692: } 693: print COPYCOUNT 'time='.time."\n"; 694: close(COPYCOUNT); 695: } 696: 697: } # end of scope for %copyrights 698: 699: ######################################################## 700: ######################################################## 701: ### ### 702: ### Miscellanous Utility Routines ### 703: ### ### 704: ######################################################## 705: ######################################################## 706: ## 707: ## &ishome($username) 708: ## Returns 1 if $username is a LON-CAPA author, 0 otherwise 709: ## (copied from lond, modification of the return value) 710: sub ishome { 711: my $author=shift; 712: $author=~s{/home/httpd/html/res/([^/]*)/([^/]*).*}{$1/$2}; 713: my ($udom,$uname)=split(/\//,$author); 714: my $proname=propath($udom,$uname); 715: if (-e $proname) { 716: return 1; 717: } else { 718: return 0; 719: } 720: } 721: 722: ## 723: ## &declutter($filename) 724: ## Given a filename, returns a url for the filename. 725: sub declutter { 726: my $thisfn=shift; 727: $thisfn=~s/^$Apache::lonnet::perlvar{'lonDocRoot'}//; 728: $thisfn=~s/^\///; 729: $thisfn=~s/^res\///; 730: return $thisfn; 731: } 732: