Revision 3629
Added by walbridge over 16 years ago
| src/perl/register-dataset.cgi | ||
|---|---|---|
| 4256 | 4256 |
if ($debug) {
|
| 4257 | 4257 |
print STDERR "$msg\n"; |
| 4258 | 4258 |
} |
| 4259 |
else {
|
|
| 4260 |
# This empty print statement is to prevent a bizzare error of the NCEAS |
|
| 4261 |
# skin failing when: debug = 0, and a file upload is attached. Maybe |
|
| 4262 |
# related to function return values? |
|
| 4263 |
print ""; |
|
| 4264 |
} |
|
| 4259 | 4265 |
} |
| 4260 | 4266 |
|
| 4261 | 4267 |
################################################################################ |
| ... | ... | |
| 4265 | 4271 |
################################################################################ |
| 4266 | 4272 |
sub getProjectList {
|
| 4267 | 4273 |
my $projects; |
| 4268 |
if ($debug) {
|
|
| 4269 |
#my $projects = getTestProjectListFromTextFile(); |
|
| 4274 |
|
|
| 4275 |
# Check for availability AdminDB.pm, for accessing NCEAS projects |
|
| 4276 |
eval { require NCEAS::AdminDB };
|
|
| 4277 |
if ($@) {
|
|
| 4270 | 4278 |
$projects = getTestProjectList(); |
| 4271 | 4279 |
} else {
|
| 4272 |
require NCEAS::AdminDB; |
|
| 4273 | 4280 |
my $admindb = NCEAS::AdminDB->new(); |
| 4274 | 4281 |
$admindb->connect($nceas_db, $nceas_db_user, $nceas_db_password); |
| 4275 |
$projects = $admindb->getProjects(); |
|
| 4282 |
if ($admindb->{'connected'}) {
|
|
| 4283 |
$projects = $admindb->getProjects(); |
|
| 4284 |
} else {
|
|
| 4285 |
$projects = $admindb->getTestProjectList(); |
|
| 4286 |
} |
|
| 4276 | 4287 |
} |
| 4277 | 4288 |
return $projects; |
| 4278 | 4289 |
} |
| ... | ... | |
| 4309 | 4320 |
$projects[6] = \@row7; |
| 4310 | 4321 |
return \@projects; |
| 4311 | 4322 |
} |
| 4312 |
|
|
| 4313 |
################################################################################ |
|
| 4314 |
# |
|
| 4315 |
# get a list of projects from a text file where the NCEAS |
|
| 4316 |
# admin db is not available. |
|
| 4317 |
# |
|
| 4318 |
################################################################################ |
|
| 4319 |
sub getTestProjectListFromTextFile {
|
|
| 4320 |
my @projects; |
|
| 4321 |
my $listname = "projects.txt"; |
|
| 4322 |
|
|
| 4323 |
my $count = 0; |
|
| 4324 |
open(file,$listname) || die ("Couldn't open the file");
|
|
| 4325 |
while(<file>) {
|
|
| 4326 |
chomp(); |
|
| 4327 |
#print $_; |
|
| 4328 |
|
|
| 4329 |
my @row; |
|
| 4330 |
my ($projectid, $pilast, $pifirst, $ptitle, $stitle) = split(':', $_);
|
|
| 4331 |
$pilast =~ s/ //g; |
|
| 4332 |
$pifirst =~ s/ //g; |
|
| 4333 |
$ptitle =~ s/(( )|(^ )|( $))//g; |
|
| 4334 |
$stitle =~ s/(( )|(^ )|( $))//g; |
|
| 4335 |
|
|
| 4336 |
$row[0] = $projectid; |
|
| 4337 |
$row[1] = $pilast; |
|
| 4338 |
$row[2] = $pifirst; |
|
| 4339 |
$row[3] = $ptitle; |
|
| 4340 |
$row[4] = $stitle; |
|
| 4341 |
|
|
| 4342 |
$projects[$count++] = \@row; |
|
| 4343 |
} |
|
| 4344 |
|
|
| 4345 |
return \@projects; |
|
| 4346 |
} |
|
Also available in: Unified diff
Workaround for a bizzare submission issue stemming from the debug sub. Modified the NCEAS project list to be robust and rely on the presence of the AdminDB module and a working connection to the DB for listing projects.