From 2dd3a24d39e35cfe398685c4abdfd9bb85dc2a0c Mon Sep 17 00:00:00 2001 From: Dennis Eriksen Date: Fri, 1 Nov 2019 13:31:38 +0100 Subject: Initial commit --- form | 81 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 81 insertions(+) create mode 100755 form (limited to 'form') 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 + +use strict; +use warnings; + +use CGI; +use DBI; + +my $q = CGI->new; # create CGI object + +print $q->header(-charset=>'utf-8'); +print < + + PURL + + +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.
\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
\n"; + print "Shortened to: $shortURL
\n"; + print "
\n"; +} + +# print form +print < + Username: $user
+ URL to shorten:
+ Custom short:
+ + + + + +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; +} -- cgit v1.2.3