diff options
author | Dennis Eriksen <d@ennis.no> | 2019-11-01 14:22:53 +0100 |
---|---|---|
committer | Dennis Eriksen <d@ennis.no> | 2019-11-01 14:22:53 +0100 |
commit | 152218ae18c000e8bb2e9a5982353e92cf6fa25c (patch) | |
tree | 0183dd5fb4ad6444ebefd232673499127f78ab6f /form | |
parent | Initial commit (diff) | |
download | purl-152218ae18c000e8bb2e9a5982353e92cf6fa25c.tar.gz |
Just giving the executables file-endings
Diffstat (limited to 'form')
-rwxr-xr-x | form | 81 |
1 files changed, 0 insertions, 81 deletions
@@ -1,81 +0,0 @@ -#!/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; -} |