source: branches/help/SH/dszmconnect.pl

Last change on this file was 16766, checked in by westram, 7 years ago
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 3.5 KB
Line 
1#!/usr/bin/perl -w
2# switches for stringent coding and debugging
3
4# This program is an adapter between the ARB program package and the DSZM website.
5# It allows to run a taxonomic query using the web form offered by the DSZM via
6# the http-POST method implemented by the LWP package of perl.
7# Subsequent modification of relative URLs into absolute one allows allows the browser
8# started by ARB to connect with the DSZM website.
9#  (c) Lothar Richter Oct. 2003
10
11use strict;
12use diagnostics;
13
14
15# script for automated information retrieval from DSZM
16
17
18# moduls in use
19use LWP::Simple;
20use HTTP::Request::Common qw(POST);
21use LWP::UserAgent;
22
23use File::Temp qw/ tempfile tempdir /;
24
25
26
27
28#die"code successful parsed and compiled\n";
29
30
31
32
33my $errordocument = 
34"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
35<html>
36  <head>
37    <title>DSMZ Failure</title>
38  </head>
39
40  <body>
41    <h1>DSZM Access Error</h1>
42<br/>
43You have given no search items! Please give at least on search item to access the taxonomic search tool at the DSMZ!
44
45    <hr>
46    <address><a href=\"mailto:\">Lothar Richter</a></address>
47<!-- Created: Mon Sep  8 14:23:58 CEST 2003 -->
48<!-- hhmts start -->
49Last modified: Mon Sep  8 14:25:42 CEST 2003
50<!-- hhmts end -->
51  </body>
52</html>";
53
54my $TMPOUT;
55my $template = 'arbdsmz_XXXXXX';
56(undef, $TMPOUT) = tempfile($template, OPEN => 0);
57$TMPOUT = $TMPOUT . ".html";
58
59open (OUTPUT , "> $TMPOUT") or die "cannot open temporary input file $TMPOUT";
60
61if (scalar(@ARGV) == 0) {
62  print OUTPUT $errordocument;
63  die("no search items given ! Give at least one item!");
64}
65##print length(@ARGV)."\n";
66my $item1 = shift() || "";
67##print $item1."\n";
68my $item2 = shift() || "";
69
70print STDERR "Searching for '$item1'\n";
71print STDERR "Searching for '$item2'\n";
72
73#--------------------------------------------------------------------------------
74# begin of post-method emulations
75#--------------------------------------------------------------------------------
76
77
78 my $ua_selection = LWP::UserAgent ->new ;
79
80 #$ua_selection -> agent ("UpdateAgent/0.1" . $ua_selection -> agent);
81
82 ##my $req_selection = new HTTP::Request POST => $baseURL;
83 my $req_selection =  HTTP::Request -> new( POST => 'http://www.dsmz.de/cgi-bin/dsmzfind.pl');
84 ##my $req_selection =  HTTP::Request -> new( POST => $baseURL);
85
86 $req_selection->content_type('application/x-www-form-urlencoded');
87# my $selection_content = 'VAR_DATABASE=bact&VAR_HITS=25&VAR_DSMZITEM=Escherichia&VAR_DSMZITEM2=coli&B1=Search';
88 my $selection_content = 'VAR_DATABASE=bact&VAR_HITS=25&VAR_DSMZITEM='."$item1".'&VAR_DSMZITEM2='."$item2".'&B1=Search';
89
90 $req_selection->content($selection_content);
91
92 # Pass request to the user agent and get a response back
93 my $TMPUSEROUT;
94 (undef, $TMPUSEROUT) = tempfile($template, OPEN => 0);
95 $TMPUSEROUT = $TMPUSEROUT . ".htm";
96 my $res_selection = $ua_selection -> request($req_selection, $TMPUSEROUT);
97
98
99
100 # Check the outcome of the response
101 if ($res_selection->is_success) {print $res_selection->content;} 
102 else  {die "Bad luck this time, request failed\n";};
103
104
105open (INPUT , "< $TMPUSEROUT") or die "cannot open input file $TMPUSEROUT";
106
107
108 my $htmlcontent;
109{
110local $/;
111$htmlcontent = <INPUT>;
112}
113##print "$htmlcontent\n";
114
115##$htmlcontent =~ s{(.*HREF=")(\/w+)}{$1http:\/\/www.dszm.de$1}igm; ##"
116$htmlcontent =~ s{HREF="}{HREF="http://www.dsmz.de}igm;
117$htmlcontent =~ s{HREF=[^"]}{HREF=http://www.dsmz.de/}igm; ##"
118
119print OUTPUT $htmlcontent ;
120
121#exec ('netscape', $TMPOUT);
122print "file://" . $TMPOUT;
123
124##print "$htmlcontent\n";
Note: See TracBrowser for help on using the repository browser.