転送URLをするPerl CGI

Tweet

転送URLを実現するCGIを書いてみました。なんとなく仕事で必要なので。あと、このソースだと、転送URLの対応表は直書きですｗ

Filename: shorturl.cgi

#!/usr/bin/perl
use strict;
use warnings;
use CGI;
 
# main
package main;
my $q     = CGI->new();
my $query = $q->param('q');
my $a     = redirect->new();
$a->set_dict( \&list );
$a->query_redirect($query);
exit;
 
# replace function
sub list {
  my $query = shift;
  return undef unless defined $query;
  my $hash_list =
    {
      '1' => 'http://www.dtpwiki.jp/',
      '2' => 'http://dtpwiki.jp/',
    };
  
  return exists($hash_list->{$query})
           ?$hash_list->{$query}:undef;
}
 
# redirect
package redirect;
sub new{
  return bless{ _DATA => { } }, shift;
}
sub dataref  { $_[0]->{ _DATA } }
sub set_dict {
  my $self = shift;
  my $sub  = shift;
  $self->dataref->{'dict_sub'} = $sub;
  return;
}
sub query {
  my $self  = shift;
  my $query = shift;
  return $self->dataref->{'dict_sub'}->( $query );
}
sub redirect {
  require CGI;
  my $self = shift;
  my $url  = shift;
  my $q = CGI->new();
  if ( defined $url ) {
    print $q->redirect( $url );
    return;
  }
  else {
    print $q->header( -status => 404 );
    print "404 not found\n";
    return;
  }
}
sub query_redirect {
  my $self = shift;
  my $q    = shift;
  $self->redirect(
    $self->query( $q )
  );
  return;
}
1;

OOPにしてみたので、オブジェクトを生成した後、URLの対応付けを行うサブルーチンを参照渡しで設定するようなかんじになっています。だから、ナントカSQLによる辞書参照ルーチンを付けるといいんだけどめんどくさくなって放置。

なんつうか、TinyURLとかYouTubeみたいに、英字のパーマリンクみたいにしたいんですけれども、エンコード新たに作るのも億劫で。どっかにYouTubeのPermalink解説したページあったと思ったけど今探すと、YouTubeもPermalinkも一般的単語すぎて見つからんなー

2007.12.24 01:05 投稿　大野 義貴 [Script] | 固定リンク |