Revision 1953
Added by Matt Jones over 20 years ago
| src/perl/Metacat/Metacat.pm | ||
|---|---|---|
| 277 | 277 |
} |
| 278 | 278 |
|
| 279 | 279 |
############################################################# |
| 280 |
# subroutine to get the maximimum id in a series |
|
| 281 |
# If success, return max id, else return 0 |
|
| 282 |
############################################################# |
|
| 283 |
sub getLastId {
|
|
| 284 |
my $self = shift; |
|
| 285 |
my $scope = shift; |
|
| 286 |
|
|
| 287 |
my $returnval = 0; |
|
| 288 |
|
|
| 289 |
my %postData = ( action => 'getlastdocid', |
|
| 290 |
scope => $scope |
|
| 291 |
); |
|
| 292 |
|
|
| 293 |
my $response = $self->sendData(%postData); |
|
| 294 |
if (($response) && $response->content =~ /<docid>(.*)<\/docid>/s) {
|
|
| 295 |
$returnval = "$1"; |
|
| 296 |
} elsif (($response)) {
|
|
| 297 |
$returnval = 0; |
|
| 298 |
#print "Error response from sendData!\n"; |
|
| 299 |
#print $response->content, "\n"; |
|
| 300 |
} else {
|
|
| 301 |
$returnval = 0; |
|
| 302 |
#print "Invalid response from sendData!\n"; |
|
| 303 |
} |
|
| 304 |
|
|
| 305 |
return $returnval; |
|
| 306 |
} |
|
| 307 |
############################################################# |
|
| 280 | 308 |
# subroutine to get the message returned from the last executed |
| 281 | 309 |
# metacat action. These are generally XML formatted messages. |
| 282 | 310 |
############################################################# |
| ... | ... | |
| 324 | 352 |
$resultset = $metacat->squery($pathquery); |
| 325 | 353 |
print $resultset; |
| 326 | 354 |
$response = $metacat->delete($docid); |
| 355 |
my $lastid = $metacat->getLastId("obfs");
|
|
| 327 | 356 |
print $metacat->getMessage(); |
| 328 | 357 |
$response = $metacat->getCookies(); |
| 329 | 358 |
print $metacat->getMessage(); |
| src/perl/Metacat/test.pl | ||
|---|---|---|
| 40 | 40 |
# Insert your test code below (better if it prints "ok 13" |
| 41 | 41 |
# (correspondingly "not ok 13") depending on the success of chunk 13 |
| 42 | 42 |
# of the test code): |
| 43 |
my $metacatUrl = "http://dev.nceas.ucsb.edu/jones/servlet/metacat";
|
|
| 44 |
my $username = 'jones';
|
|
| 43 |
my $metacatUrl = "http://snow.joneseckert.org:8080/knb/servlet/metacat";
|
|
| 44 |
my $username = 'uid=jones,o=NCEAS,dc=ecoinformatics,dc=org';
|
|
| 45 | 45 |
my $password = 'your-pw-goes-here'; |
| 46 | 46 |
|
| 47 | 47 |
# Set up a date stamp |
| ... | ... | |
| 60 | 60 |
my $timenow="$mday-$thismon-$year $hour:$minstr:$secstr"; |
| 61 | 61 |
|
| 62 | 62 |
# Set up a document accession number to use |
| 63 |
my $docroot = "$thismon$mday.$minstr."; |
|
| 63 |
my $scope = "$thismon$mday"; |
|
| 64 |
my $docroot = "$scope.$minstr."; |
|
| 64 | 65 |
my $docrev = 1; |
| 65 | 66 |
|
| 66 | 67 |
# Chunk 2: Test metacat object creation |
| ... | ... | |
| 129 | 130 |
print $metacat->getMessage(); |
| 130 | 131 |
print "not ok 8 delete\n"; |
| 131 | 132 |
} |
| 133 |
|
|
| 134 |
# Chunk 9: Test metacat getlastid |
|
| 135 |
my $response = $metacat->getLastId("$scope");
|
|
| 136 |
if ($response) {
|
|
| 137 |
print "ok 9 getlastid ($response)\n"; |
|
| 138 |
} else {
|
|
| 139 |
print $metacat->getMessage(); |
|
| 140 |
print "not ok 9 getlastid\n"; |
|
| 141 |
} |
|
Also available in: Unified diff
Added new function "getLastId" to the Metacat.pm perl Metacat client. Returns
the hisghest docid in use in a given scope.