PURL

#!/bin/perl -wT # (c) 2019-2022 Dennis Eriksen 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.
\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
\n"; $results .= "Shortened to: $shortURL
\n"; $results .= "

\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 < PURL $results 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; }