1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
#!/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
my $results;
my $user = scalar $ENV{'REMOTE_USER'};
my $form = scalar $q->param('form');
# 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)) {
$results .= "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://'; # http/https
my $shortURL = $proto . $ENV{'SERVER_NAME'} . '/' . $short;
$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";
}
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>
HTML
}
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;
}
|
