#!/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; }