#!/usr/bin/perl -w use strict; # # Tiny, your own URL shortening service # Mark Paschal # # # Copyright 2003 Mark Paschal # # Permission is hereby granted, free of charge, to any person # obtaining a copy of this software and associated documentation files # (the "Software"), to deal in the Software without restriction, # including without limitation the rights to use, copy, modify, merge, # publish, distribute, sublicense, and/or sell copies of the Software, # and to permit persons to whom the Software is furnished to do so, # subject to the following conditions: # # The above copyright notice and this permission notice shall be # included in all copies or substantial portions of the Software. # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, # EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND # NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS # BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN # ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN # CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE # SOFTWARE. # # Change this to chdir wherever you want to keep data. If the directory # is a browseable location, people will be able to look up the submitted # URLs. You should create this directory; Tiny will not create it itself. chdir('tiny'); # Given a nonnegative number, returns it as a base 26 number using the # lowercase Latin alphabet for digits. sub numLet { my $num = shift; my @letters = split //, 'zabcdefghijklmnopqrstuvwxy'; my $let = ''; while($num) { my $hey = $num % 26; $num = int($num / 26); $let .= $letters[$hey]; }; return $let; } # Save the given URL to the next URL record. sub put { my $url = shift; open(Touchme, '>counter.dat') && close(Touchme) unless -e 'counter.dat'; open(Counter, '+; chomp $counter; $counter++; seek Counter, 0, 0; print Counter $counter; close(Counter); my $cfile = numLet($counter); die "OMG the URL record $cfile already exists" if -e $cfile; open(Cfile, ">$cfile") || die "OMG opening URL record $cfile to write: $!"; print Cfile $url; close(Cfile); return $cfile; } # Return the URL for the given URL record. sub get { my $cfile = shift; open(Cfile, "<$cfile") || die "OMG opening URL record $cfile to read: $!"; my $url = ; close(Cfile); chomp $url; return $url; } # Print the given message as a 500 error and exit. sub error { my $error = shift; print < $ENV{'SCRIPT_NAME'}

The new URL for $url is:

$redirUrl

EOF exit; } # http://script/ ? Print a submission form. print < $ENV{'SCRIPT_NAME'}

URL to shorten:

Bookmarklet

EOF