form.cgi


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

#!/bin/perl -wT
# (c) 2019-2022 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();
    }

    # Insert short and url into database
    $query = qq(INSERT INTO shorts (url, short, created_by) VALUES (?, ?, ?););
    my $sth = $dbh->prepare( $query );
    $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;
}