1 files changed, 81 insertions, 0 deletions
diff --git a/form b/form
new file mode 100755
index 0000000..e10386d
--- /dev/null
+++ b/form
@@ -0,0 +1,81 @@
+#!/bin/perl -wT
+# (c) 2019 Dennis Eriksen <https://dnns.no>
+
+use strict;
+use warnings;
+
+use CGI;
+use DBI;
+
+my $q = CGI->new;       # create CGI object
+
+print $q->header(-charset=>'utf-8');
+print <<HTML;
+<html>
+<head>
+    <title>PURL</title>
+</head>
+<body>
+HTML
+my $user = scalar $ENV{'REMOTE_USER'};
+
+# If form has already been submitted
+if ($q->param('url')) {
+    my $url = scalar $q->param('url');
+    my $short;
+
+    if ($q->param('short')) {
+        $short = scalar $q->param('short');
+    } else {
+        $short = genshort();
+    }
+
+    # create database handler
+    my $dbh = DBI->connect("dbi:Pg:dbname=purl") or die $DBI::errstr;
+    
+    # SQL Query
+    my $query = qq(SELECT shorts.url FROM shorts WHERE shorts.short = ?;);
+    
+    # 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";
+        $short = genshort();
+        last;
+    }
+
+    # Insert short and url into database
+    $query = qq(INSERT INTO shorts (url, short, created_by) VALUES (?, ?, ?););
+    my $sth = $dbh->prepare( $query );
+    my $rv = $sth->execute($url, $short, $user) or die $sth->errstr;
+    $dbh->disconnect();
+
+
+    my $proto = $ENV{'HTTPS'} eq "on" ? 'https://' : 'http://';
+    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";
+}
+
+# print form
+print <<FORM;
+    <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="submit" value="Submit">
+    </form>
+
+</body>
+</html>
+FORM
+
+exit(0);
+
+sub genshort {
+    my $random_number = int(rand(3)) +2; # random length of short
+    my @chars = ("A".."Z", "a".."z", 0..9);
+    my $short;
+    $short .= $chars[rand @chars] for 1..$random_number; # generate short
+    return $short;
+}