diff options
| author | Dennis Eriksen <d@ennis.no> | 2019-11-01 17:13:40 +0100 |
|---|---|---|
| committer | Dennis Eriksen <d@ennis.no> | 2019-11-01 17:13:40 +0100 |
| commit | e9d3a1e6796d450ab00a6a6d95b8ace53b7f93fd (patch) | |
| tree | a33e21079c73694dcced0d8880be5c7227d90a7d | |
| parent | Just giving the executables file-endings (diff) | |
| download | purl-e9d3a1e6796d450ab00a6a6d95b8ace53b7f93fd.tar.gz | |
we now support curling the form without getting all of the HTML in response
| -rwxr-xr-x | form.cgi | 44 | ||||
| -rwxr-xr-x | redirect.cgi | 2 |
2 files changed, 28 insertions, 18 deletions
@@ -7,17 +7,11 @@ use warnings; use CGI; use DBI; -my $q = CGI->new; # create CGI object +my $q = CGI->new; # create CGI object -print $q->header(-charset=>'utf-8'); -print <<HTML; -<html> -<head> - <title>PURL</title> -</head> -<body> -HTML +my $results; my $user = scalar $ENV{'REMOTE_USER'}; +my $form = scalar $q->param('form'); # If form has already been submitted if ($q->param('url')) { @@ -38,7 +32,7 @@ if ($q->param('url')) { # Check if short exists. If it does, generate a new one. while (my $url = $dbh->selectrow_array($query, undef, $short)) { - print "Your short exists. Generating new.<br>\n"; + $results .= "Your short exists. Generating new.<br>\n"; $short = genshort(); last; } @@ -50,25 +44,41 @@ if ($q->param('url')) { $dbh->disconnect(); - my $proto = $ENV{'HTTPS'} eq "on" ? 'https://' : 'http://'; + my $proto = $ENV{'HTTPS'} eq "on" ? 'https://' : 'http://'; # http/https my $shortURL = $proto . $ENV{'SERVER_NAME'} . '/' . $short; - print "URL: $url<br>\n"; - print "Shortened to: <a href=\"$shortURL\">$shortURL</a><br>\n"; - print "<hr>\n"; + $results .= "URL: $url<br>\n"; + $results .= "Shortened to: <a href=\"$shortURL\">$shortURL</a><br>\n"; + $results .= "<hr>\n"; + + # Change results if we are not submitting via the form + $results = $form eq "html" ? $results : $shortURL . "\n"; } -# print form -print <<FORM; +if ($form ne "html" and $results ne "") { # if we did not use the form, and there are no results + print $q->header(-charset=>'utf-8'); + print $results; +} else { # if we used the form + # print form + print $q->header(-charset=>'utf-8'); + print <<HTML; +<html> +<head> + <title>PURL</title> +</head> +<body> + $results <form method="post" action="/purl.cgi" enctype="multipart/form-data" name="main"> Username: $user<br> URL to shorten: <input type="text" name="url" size="50"><br> Custom short: <input type="text" name="short"><br> + <input type="hidden" name="form" value="html"> <input type="submit" value="Submit"> </form> </body> </html> -FORM +HTML +} exit(0); diff --git a/redirect.cgi b/redirect.cgi index c471831..9af5ed9 100755 --- a/redirect.cgi +++ b/redirect.cgi @@ -13,7 +13,7 @@ my $q = CGI->new; # create CGI object my $dbh = DBI->connect("dbi:Pg:dbname=purl") or die $DBI::errstr; # set the short -my $short = $ENV{REQUEST_URI}; +my $short = scalar $ENV{REQUEST_URI}; $short =~ s/^\///; # SQL Query |