#!/bin/env perl # # ========================================================================= # File: search-proxy.cgi # # Copyright (c) 2006 and onwards, Josh Glover # # LICENCE: # # This file is distributed under the terms of the BSD-2 License. # See the COPYING file, which should have been distributed with # this file, for details. If you did not receive the COPYING file, # see: # # http://www.jmglov.net/opensource/licenses/bsd.txt # # DESCRIPTION: # # Proxies keyword query string to the search engine of your choice. # # USAGE: # # search-proxy.cgi?e=& # # EXAMPLES: # # search-proxy.cgi?e=google.com&q=foo # # TODO: # # - Nothing, this code is perfect # # DEPENDENCIES: # # - Perl 5.6.0 or newer # - CPAN modules: # - CGI # - LWP::UserAgent # - URI::Escape # # MODIFICATIONS: # # Josh Glover (2006/10/22): Initial revision # ========================================================================= use strict; use warnings; use CGI (); use File::Basename (); use LWP::UserAgent (); use URI::Escape (); use subs qw(error); # Globals # ============================================================================== our $ME = File::Basename::basename $0; our $VERSION = 1.0.0; # ============================================================================== # Constants # ============================================================================== use constant DEBUG => 1; use constant DEFAULT_ENGINE => 'http://google.com/search'; use constant DEFAULT_PROTO => 'http://'; use constant PARAM_ENGINE => 'e'; use constant PROTOCOL_REGEX => qr,^[^:]+://,; use constant DEFAULT_CONTENT_TYPE => "Content-type: text/html\r\n\r\n"; use constant CONTENT_TYPE_REGEX => qr,,i; use constant USERAGENT_STR => 'Firefox/1.5'; # ============================================================================== # Main program # ============================================================================== my $q = CGI->new(); if (DEBUG) { print STDERR ("$_=". $q->param($_) ."\n") for $q->param; } # If the user has specified a search engine, use it my $engine = $q->param(PARAM_ENGINE); # Otherwise, use the default engine $engine ||= DEFAULT_ENGINE; # If the engine does not start with a protocol definition, provide one my $proto = DEFAULT_PROTO; $engine =~ s/^/$proto/ unless $engine =~ PROTOCOL_REGEX; # Delete the engine param if it exists, then make a string out of the rest of # the params $q->delete(PARAM_ENGINE); my $query_str = ""; $query_str .= ("$_=". URI::Escape::uri_escape($q->param($_)) .";") for $q->param; # Set up the LWP::UA object my $ua = LWP::UserAgent->new; $ua->agent(USERAGENT_STR); # Create the request object and perform the request my $req = HTTP::Request->new(GET => "$engine?$query_str"); my $res = $ua->request($req); # If the response was unsuccessful exit with an error error($res->status_line) unless $res->is_success; # If control reaches here, the response was successful # If the response includes a directive, use # it as our content-type my $content_type = "Content-type: $1\r\n\r\n" if $res->content =~ CONTENT_TYPE_REGEX; $content_type ||= DEFAULT_CONTENT_TYPE; ### Code to munge URIs goes here # Print out the response as is print $content_type, $res->content; # And we're done exit; # ============================================================================== # Subroutines # ============================================================================== # Sub: error() # # Displays an error message and exits # # Parameters: # # msg - list of error messages to display (list elements will be delimited # with
s in the output) sub error { print DEFAULT_CONTENT_TYPE, qq+ $ME error

$ME error

+. join('
') .qq+

+; } # error() # ==============================================================================