Data lab initialization

1 files changed, 138 insertions, 0 deletions

diff --git a/datalab-handout/Driverlib.pm b/datalab-handout/Driverlib.pm
new file mode 100644
index 0000000..d7f7da1
--- /dev/null
+++ b/datalab-handout/Driverlib.pm
@@ -0,0 +1,138 @@
+###############################################################
+# Driverlib.pm - A package of helper functions for Perl drivers
+# 
+# Copyright (c) 2005 David R. O'Hallaron, All rights reserved.
+###############################################################
+
+package Driverlib;
+
+use Socket;
+
+# Autogenerated header file with lab-specific constants
+use lib ".";
+use Driverhdrs;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(
+	     driver_post
+	     );
+
+use strict;
+
+#####
+# Public functions
+#
+
+#
+# driver_post - This is the routine that a driver calls when 
+#    it needs to transmit an autoresult string to the result server.
+#
+sub driver_post ($$) {
+    my $userid = shift;       # User id for this submission
+    my $result = shift;       # Autoresult string
+    my $autograded = shift;   # Set if called by an autograder
+
+    # Echo the autoresult string to stdout if the driver was called
+    # by an autograder
+    if ($autograded) {
+        print "\n";
+        print "AUTORESULT_STRING=$result\n";
+        return;
+    }	
+
+    # If the driver was called with a specific userid, then submit
+    # the autoresult string to the result server over the Internet.
+    if ($userid) {
+        my $status = submitr($Driverhdrs::SERVER_NAME, 
+                             $Driverhdrs::SERVER_PORT, 
+                             $Driverhdrs::COURSE_NAME, 
+                             $userid, 
+                             $Driverhdrs::LAB, 
+                             $result);
+        
+        # Print the status of the transfer
+        if (!($status =~ /OK/)) {
+            print "$status\n";
+            print "Did not send autoresult string to the result server.\n";
+            exit(1);
+        }
+        print "Success: Sent autoresult string for $userid to the result server.\n";
+    }	
+}
+
+
+#####
+# Private functions
+#
+
+#
+# submitr - Sends an autoresult string to the result server
+#
+sub submitr ($$$$$$) {
+    my $hostname = shift;
+    my $port = shift;
+    my $course = shift;
+    my $userid = shift;
+    my $lab = shift;
+    my $result = shift;
+
+    my $internet_addr;
+    my $enc_result;
+    my $paddr;
+    my $line;
+    my $http_version;
+    my $errcode;
+    my $errmsg;
+
+    # Establish the connection to the server
+    socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
+    $internet_addr = inet_aton($hostname)
+        or die "Could not convert $hostname to an internet address: $!\n";
+    $paddr = sockaddr_in($port, $internet_addr);
+    connect(SERVER, $paddr)
+        or die "Could not connect to $hostname:$port:$!\n";
+
+    select((select(SERVER), $| = 1)[0]); # enable command buffering
+
+    # Send HTTP request to server
+    $enc_result = url_encode($result);
+    print SERVER  "GET /$course/submitr.pl/?userid=$userid&lab=$lab&result=$enc_result&submit=submit HTTP/1.0\r\n\r\n";
+
+    # Get first HTTP response line
+    $line = <SERVER>;
+    chomp($line);
+    ($http_version, $errcode, $errmsg) = split(/\s+/, $line);
+    if ($errcode != 200) {
+        return "Error: HTTP request failed with error $errcode: $errmsg";
+    }
+
+    # Read the remaining HTTP response header lines
+    while ($line = <SERVER>) {
+        if ($line =~ /^\r\n/) {
+            last;
+        }
+    }
+
+    # Read and return the response from the result server
+    $line = <SERVER>;
+    chomp($line);
+
+    close SERVER;
+    return $line;
+    
+}
+
+#
+# url_encode - Encode text string so it can be included in URI of GET request
+#
+sub url_encode ($) {
+    my $value = shift;
+
+    $value =~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
+    return $value;
+}
+
+# Always end a module with a 1 so that it returns TRUE
+1;
+