Revision 3421
Added by walbridge over 17 years ago
| src/perl/Metacat/Metacat.pm | ||
|---|---|---|
| 31 | 31 |
use AutoLoader qw(AUTOLOAD); |
| 32 | 32 |
|
| 33 | 33 |
use LWP::UserAgent; |
| 34 |
use HTTP::Request::Common qw(POST); |
|
| 34 | 35 |
use HTTP::Cookies; |
| 35 | 36 |
|
| 36 | 37 |
our @ISA = qw(Exporter); |
| ... | ... | |
| 62 | 63 |
# which can later be changed using "set_options" |
| 63 | 64 |
############################################################# |
| 64 | 65 |
sub new {
|
| 66 |
my($type,$metacatUrl) = @_; |
|
| 65 | 67 |
my $cookie_jar = HTTP::Cookies->new; |
| 66 | 68 |
|
| 67 |
my $type = {
|
|
| 68 |
metacatUrl => 'http://dev.nceas.ucsb.edu/jones/servlet/metacat',
|
|
| 69 |
my $self = {
|
|
| 70 |
metacatUrl => $metacatUrl,
|
|
| 69 | 71 |
message => '', |
| 70 | 72 |
cookies => \$cookie_jar |
| 71 | 73 |
}; |
| 72 | 74 |
|
| 73 |
bless $type, shift;
|
|
| 74 |
return $type;
|
|
| 75 |
bless $self, $type;
|
|
| 76 |
return $self;
|
|
| 75 | 77 |
} |
| 76 | 78 |
|
| 77 | 79 |
############################################################# |
| ... | ... | |
| 99 | 101 |
$self->{'message'} = '';
|
| 100 | 102 |
my $userAgent = new LWP::UserAgent; |
| 101 | 103 |
$userAgent->agent("MetacatClient/1.0");
|
| 102 |
|
|
| 103 |
my $request = new HTTP::Request('POST' => "$self->{'metacatUrl'}");
|
|
| 104 |
|
|
| 105 |
# determine encoding type |
|
| 106 |
my $contentType = 'application/x-www-form-urlencoded'; |
|
| 107 |
if ($postData{'enctype'}) {
|
|
| 108 |
$contentType = $postData{'enctype'};
|
|
| 109 |
delete $postData{'enctype'};
|
|
| 110 |
} |
|
| 111 |
|
|
| 112 |
my $request = POST("$self->{'metacatUrl'}",
|
|
| 113 |
Content_Type => $contentType, |
|
| 114 |
Content => \%postData |
|
| 115 |
); |
|
| 116 |
|
|
| 117 |
# set cookies on UA object |
|
| 104 | 118 |
my $cookie_jar = $self->{'cookies'};
|
| 105 | 119 |
$$cookie_jar->add_cookie_header($request); |
| 106 |
$request->content_type('application/x-www-form-urlencoded');
|
|
| 107 |
foreach my $key (keys %postData) {
|
|
| 108 |
$request->add_content("$key=$postData{$key}&")
|
|
| 109 |
} |
|
| 120 |
#print "request: " . $request->as_string(); |
|
| 110 | 121 |
|
| 111 | 122 |
my $response = $userAgent->request($request); |
| 112 |
|
|
| 123 |
#print "response: " . $response->as_string(); |
|
| 124 |
|
|
| 113 | 125 |
if ($response->is_success) {
|
| 114 | 126 |
# save the cookies |
| 115 | 127 |
$$cookie_jar->extract_cookies($response); |
| ... | ... | |
| 224 | 236 |
return $returnval; |
| 225 | 237 |
} |
| 226 | 238 |
|
| 239 |
############################################################ |
|
| 240 |
# subroutine to upload an XML document in Metacat |
|
| 241 |
# If success, return 1, else return 0 |
|
| 227 | 242 |
############################################################# |
| 243 |
sub upload {
|
|
| 244 |
my $self = shift; |
|
| 245 |
my $docid = shift; |
|
| 246 |
my $datafile = shift; |
|
| 247 |
|
|
| 248 |
my $returnval = 0; |
|
| 249 |
|
|
| 250 |
my %postData = ( action => 'upload', |
|
| 251 |
docid => $docid, |
|
| 252 |
datafile => [$datafile], |
|
| 253 |
enctype => 'form-data' |
|
| 254 |
); |
|
| 255 |
|
|
| 256 |
my $response = $self->sendData(%postData); |
|
| 257 |
#print "response is: $response"; |
|
| 258 |
# |
|
| 259 |
if (($response) && $response->content =~ /<success>/) {
|
|
| 260 |
$returnval = $response->content; |
|
| 261 |
} |
|
| 262 |
|
|
| 263 |
return $returnval; |
|
| 264 |
} |
|
| 265 |
|
|
| 266 |
|
|
| 267 |
############################################################# |
|
| 228 | 268 |
# subroutine to delete an XML document in Metacat |
| 229 | 269 |
# If success, return 1, else return 0 |
| 230 | 270 |
############################################################# |
Also available in: Unified diff
Added upload method. Modified sendData to respect form encodings and POST files.