Changeset 466 for locker/deploy/bin/onserver.pm

Timestamp:

Oct 14, 2007, 12:11:40 AM (17 years ago)

Author:

andersk

Message:

Prepare to get rid of curl.

File:

• locker/deploy/bin/onserver.pm (modified) (4 diffs, 1 prop)

locker/deploy/bin/onserver.pm

@@ -8 +8 @@
 use Cwd qw(abs_path);
 use POSIX qw(strftime);
+use LWP::UserAgent;
+use URI;
 our @ISA = qw(Exporter);
-our @EXPORT = qw(setup totmp print_login_info press_enter $server $tmp $USER $HOME $sname $deploy $addrend $admin_username $requires_sql $addrlast $sqlhost $sqluser $sqlpass $sqldb $sqldbcurl $admin_password $scriptsdev $human);
+our @EXPORT = qw(setup totmp fetch_uri print_login_info press_enter $server $tmp $USER $HOME $sname $deploy $addrend $admin_username $requires_sql $addrlast $sqlhost $sqluser $sqlpass $sqldb $sqldbcurl $admin_password $scriptsdev $human);
 
 our $server = "scripts.mit.edu";
@@ -20 +22 @@
   print FILE $_[0];
   close(FILE);
+}
+
+my $ua = LWP::UserAgent->new;
+my $base_uri;
+
+sub fetch_uri {
+    my ($uri, $get, $post) = @_;
+    my $u = URI->new($uri);
+    my $req;
+    if (defined $post) {
+        $u->query_form($post);
+        my $content = $u->query;
+        $u->query_form($get);
+        $req = HTTP::Request->new(POST => $u->abs($base_uri));
+        $req->content_type('application/x-www-form-urlencoded');
+        $req->content($content);
+    } else {
+        $u->query_form($get) if (defined $get);
+        $req = HTTP::Request->new(GET => $u->abs($base_uri));
+    }
+    my $res = $ua->request($req);
+    if ($res->is_success) {
+        return $res->content;
+    } else {
+        print STDERR "Error fetching configuration page: ", $res->status_line, "\n";
+        return undef;
+    }
 }
 
@@ -56 +85 @@
   }
   ($addrlast) = ($addrend =~ /([^\/]*)$/);
+  
+  $base_uri = "http://$server/~$USER/$addrend/";
   
   if($requires_sql) {
@@ -102 +133 @@
   $| = 1; # STDOUT is *hot*!
 }
+
+1;