[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]

[MacPerl] Help Request

MacPerl Community;

One of my co-workers has obtained PERL scripts that were developed in the
"NCSA httpd 1.6.31 for Linux-ELF 2.0.30" enviornment, with the intention of
dropping the files on my WebStar server and having everything run.

I have no experience with MacPERL, therefore I am seeking guidance from
someone willing to correspond via email with a new MacPERL user. I am not a
programmer. I do know some html.

What I've done so far...

1. Confiured Web* suffix mapping.

        Action   Suffix         Type    Creator         MIME

CGI Applications:
        ACGI    .ACGI           APPL        *               text/html
        CGI      .CGI             APPL         *               text/html

2. Downloaded and opened up MacPERL 5.1.3r2

3. Run the scripts through the syntax checker. The scripts come back as OK.

4. Saved the scripts as .cgi's

5. Accessed the .cgi's through Netscape with an error message that the
"Document contains no data."

Here is one of the  scripts:
=====================
#! /usr/bin/perl

$webmaster = "Warren Craddock <warren.craddock\@usa.net>";
$program = "Add User CGI for CMS Online Workshop";

print "Content-type:text/html\n\n";

&parse_form_data (*form);

&start_response;

# Verify that the passwords are the same
if ("$form{'password1'}" ne "$form{'password2'}") {
    &error ("Passwords didn't match.  You must enter the same password twice.");
}

# Make sure the password is long enough
if (length "$form{'password1'}" < 5) {
    &error ("Password must be at least five characters in length.");
}

# Concatenate to get the whole user id
$form{'teacher_id'} = "$form{'ss1'}-$form{'ss2'}-$form{'ss3'}";

# Check to see that the userfile doesn't already exist
if (-e "users/$form{'teacher_id'}") {
    &error ("You have already signed up.  To enroll in additional
workshops, please use Account Features from the Members' Lounge.");
}

# Create the user file
open (USERFILE, ">users/$form{'teacher_id'}") or die "Can't open user file.";

# Write the password to the file
$time = time;
print USERFILE "password=$time" . "," . crypt ($form{'password1'}, $time) .
"\n";

# Write the full name to the file
print USERFILE "full_name=$form{'full_name'}\n";

# Write the school name to the file
print USERFILE "school=$form{'school'}\n";

# Look for the course ID
for ($i = 0; $i < 1000; ++$i) {
    if (-e "courses/$i") {
        &get_course_descriptor($i, *course);
        # print "Course $i title: $course{'title'}\n";
        # print "Form: $form{'course'}\n";
        if ("$course{'title'}" =~ /\s*$form{'course'}\s*/i) {
            # print "Course $i matched.";
            last;
        }
    }
}

# Write the course name to the file
print USERFILE "course=$i\n";

# Congratulate the user
print "<H2>Congratulations, $form{'full_name'}, you have successfully
enrolled in the \"$form{'course'}\" Online Workshop with
Charlotte-Mecklenburg Schools.</H2><P><H3>In the future, use your social
security number and your password to log in to your workshop.</H3>";

print "<H3><A HREF=\"../login.html\">Login to the CMS Online Workshop
System</A></H3>";

&end_response;

exit (0);





sub get_course_descriptor {
    local $title = @_[0];
    local *COURSE_DATA = @_[1];

    open (COURSEFILE, "<courses/$title") or &error ("The course $title does
not exist!");
    while ($line = <COURSEFILE>) {
        @elements = split (";", $line);
        foreach $key_value (@elements) {
            ($key, $value) = split (/=/, $key_value);
            $COURSE_DATA{"$key"} = $value;
            # print "Course descriptor: " . $key . "_$line_number: $value\n";
        }
    }
}

sub start_response {
    print <<EOF;
<HTML>
<HEAD><TITLE>Register for a CMS Online Workshop</TITLE></HEAD>
<BODY BGCOLOR="#FFFFFF">
<CENTER>
<IMG SRC="../images/signup.jpg">
<HR WIDTH=300>
EOF
}

sub end_response {
    print <<EOF;
</CENTER>
</BODY>
</HTML>
EOF
}

sub error {
    local $s = $_[0];

    print <<EOF;
<H1>Your form contained invalid data:</H1>
<H2>$s</H2>
EOF

    &end_response;

    exit (0);
}

sub parse_form_data
{
    local (*FORM_DATA) = @_;
    local ( $request_method, @key_value_pairs, $key_value, $key, $value);

    $request_method = $ENV{'REQUEST_METHOD'};

    if ($request_method eq "GET") {
        $query_string = $ENV{'QUERY_STRING'};
    } elsif ($request_method eq "POST") {
        read (STDIN, $query_string, $ENV{'CONTENT_LENGTH'});
    } else {
        &return_error (500, "Server Error", "Server uses unsupported
method");
    }

#    print "Query string: $query_string\n\n";

    @key_value_pairs = split (/&/, $query_string);

    foreach $key_value (@key_value_pairs) {
        ($key, $value) = split (/=/, $key_value);
        $value =~ tr/+/ /;
        $value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;

        if (defined($FORM_DATA{$key})) {
            $FORM_DATA{$key} = join ("\0", $FORM_DATA{$key}, $value);
        } else {
            $FORM_DATA{$key} = $value;
        }

#       print "$key : $value\n";
    }
}


========================================

Thanks for any consideration you can give me in this matter.

-Bob



***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch