source: main/trunk/greenstone2/cgi-bin/talkback-transfer.pl@ 23142

Last change on this file since 23142 was 23142, checked in by davidb, 13 years ago

Fixed to correctly lookup cgi arguments 'collect' and 'oid'

  • Property svn:executable set to *
File size: 2.7 KB
Line 
1#!/usr/bin/perl -w
2
3use strict;
4
5use LWP::UserAgent;
6use HTTP::Request::Common;
7
8use CGI::Carp qw(fatalsToBrowser);
9use CGI;
10
11eval('require "./gsdlCGI.pm"');
12if ($@)
13{
14 print STDOUT "Content-type:text/plain\n\n";
15 print STDOUT "ERROR: $@\n";
16 exit 0;
17}
18
19
20sub get_infodb_type
21{
22 my ($collect_home,$collect) = @_;
23
24 print STDERR "*** Need to implement extracting infodb_type from collect.cfg\n";
25 return "gdbm";
26}
27
28
29sub oid_to_docxml_filename
30{
31 my ($collect_home,$collect,$docid) = @_;
32
33 my $infodb_type = get_infodb_type($collect_home,$collect);
34
35 # Obtain the collect and archive dir
36 my $archive_dir = &util::filename_cat($collect_home,$collect,"archives");
37
38 # Obtain the doc.xml path for the specified docID
39 my $arcinfo_doc_filename
40 = &dbutil::get_infodb_file_path($infodb_type, "archiveinf-doc",
41 $archive_dir);
42 my $doc_rec_string
43 = &dbutil::read_infodb_entry($infodb_type, $arcinfo_doc_filename,
44 $docid);
45 my $doc_rec = &dbutil::convert_infodb_string_to_hash($doc_rec_string);
46 my $doc_xml_file = $doc_rec->{'doc-file'}->[0];
47
48 # The $doc_xml_file is relative to the archives, so now let's get the
49 # full path
50 my $archives_dir = &util::filename_cat($collect_home,$collect,"archives");
51 my $doc_xml_filename = &util::filename_cat($archives_dir,$doc_xml_file);
52
53 return $doc_xml_filename;
54}
55
56sub main
57{
58 # Setup greenstone Perl include paths so additional packages can be found
59 my $gsdl_cgi = gsdlCGI->new();
60 $gsdl_cgi->setup_gsdl();
61
62 my $gsdl_home = $gsdl_cgi->get_gsdl_home();
63 my $collect_home = &util::filename_cat($gsdl_home,"collect");
64
65 require dbutil;
66 require talkback;
67
68 my $oid = $gsdl_cgi->param('oid');
69 my $collect = $gsdl_cgi->param('collect');
70
71 # sanity check
72 if (!defined $oid || !defined $collect) {
73 print STDOUT "Content-type:text/plain\n\n";
74 print STDOUT "ERROR: Malformed CGI argments. Need to specify 'oid' and 'collect'\n";
75 exit 0;
76 }
77
78 my $uniq_prefix = "$collect-$oid";
79
80 my $docxml_filename = oid_to_docxml_filename($collect_home,$collect,$oid);
81
82 my $talktoUploadURL = $gsdl_cgi->param('talktoUpload');
83
84 my $browser = LWP::UserAgent->new(agent => 'Perl File Upload');
85
86 my $response = $browser->post(
87 $talktoUploadURL,
88 [ 'yes_upload' => '1',
89 'process' => '1',
90 'oid' => $oid,
91 'collect' => $collect,
92 'uploadedfile' => [$docxml_filename, "$uniq_prefix-doc.xml"]
93 ],
94 'Content_Type' => 'form-data'
95 );
96
97 if ($response->is_success) {
98 print "Content-type:text/html\n\n";
99 print $response->content;
100 }
101 else {
102 print $response->error_as_HTML;
103 }
104
105}
106
107main();
108
Note: See TracBrowser for help on using the repository browser.