version 1.1, 2001/04/14 18:24:54
|
version 1.4, 2001/04/16 12:08:34
|
Line 8
|
Line 8
|
# directory and gathers metadata. |
# directory and gathers metadata. |
# The metadata is entered into a SQL database. |
# The metadata is entered into a SQL database. |
|
|
use strict; |
|
|
|
use IO::File; |
use IO::File; |
use HTML::TokeParser; |
use HTML::TokeParser; |
|
|
Line 35 while ($configline=<CONFIG>) {
|
Line 33 while ($configline=<CONFIG>) {
|
} |
} |
close(CONFIG); |
close(CONFIG); |
|
|
|
my $dbh; |
# ------------------------------------- Make sure that database can be accessed |
# ------------------------------------- Make sure that database can be accessed |
{ |
{ |
my $dbh; |
|
unless ( |
unless ( |
$dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) |
$dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) |
) { |
) { |
Line 47 close(CONFIG);
|
Line 45 close(CONFIG);
|
} |
} |
|
|
# ------------------------------------------------------------- get .meta files |
# ------------------------------------------------------------- get .meta files |
# need to actually loop over existing users here.. will fix soon |
opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}"); |
&find("$perlvar{'lonDocRoot'}/res"); |
my @homeusers=grep |
|
{&ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")} |
|
grep {!/^\.\.?$/} readdir(RESOURCES); |
|
closedir RESOURCES; |
|
foreach my $user (@homeusers) { |
|
&find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user"); |
|
} |
|
|
# -- process each file to get metadata and put into search catalog SQL database |
# -- process each file to get metadata and put into search catalog SQL database |
foreach my $m (@metalist) { |
foreach my $m (@metalist) { |
Line 67 foreach my $m (@metalist) {
|
Line 71 foreach my $m (@metalist) {
|
delete($ref->{'creationdate'}).','. |
delete($ref->{'creationdate'}).','. |
delete($ref->{'lastrevisiondate'}).','. |
delete($ref->{'lastrevisiondate'}).','. |
delete($ref->{'owner'}).','. |
delete($ref->{'owner'}).','. |
delete($ref->{'copyright'}). |
delete($ref->{'copyright'}) |
')'; |
')'; |
$sth->execute(); |
$sth->execute(); |
} |
} |
Line 141 sub declutter {
|
Line 145 sub declutter {
|
$thisfn=~s/^res\///; |
$thisfn=~s/^res\///; |
return $thisfn; |
return $thisfn; |
} |
} |
|
|
|
# --------------------------------------- Is this the home server of an author? |
|
# (copied from lond, modification of the return value) |
|
sub ishome { |
|
my $author=shift; |
|
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
|
my ($udom,$uname)=split(/\//,$author); |
|
my $proname=propath($udom,$uname); |
|
if (-e $proname) { |
|
return 1; |
|
} else { |
|
return 0; |
|
} |
|
} |
|
|
|
# -------------------------------------------- Return path to profile directory |
|
# (copied from lond) |
|
sub propath { |
|
my ($udom,$uname)=@_; |
|
$udom=~s/\W//g; |
|
$uname=~s/\W//g; |
|
my $subdir=$uname.'__'; |
|
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
|
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
|
return $proname; |
|
} |