DemoUsage - Demo of CGI::Portable that tracks web site usage details,
as well as e-mail backups of usage counts to the site owner.
Fcntl
Symbol
Net::SMTP 2.15 (earlier versions may work)
#!/usr/bin/perl
use strict;
use warnings;
require CGI::Portable;
my $globals = CGI::Portable->new();
use Cwd;
$globals->file_path_root( cwd() ); # let us default to current working dir
$globals->file_path_delimiter( $^O=~/Mac/i ? ":" : $^O=~/Win/i ? "\\" : "/" );
require CGI::Portable::AdapterCGI;
my $io = CGI::Portable::AdapterCGI->new();
$io->fetch_user_input( $globals );
if( $globals->user_query_param( 'debugging' ) eq 'on' ) {
$globals->is_debug( 1 );
$globals->url_query_param( 'debugging', 'on' );
}
$globals->default_application_title( 'Demo Web Site' );
$globals->default_maintainer_name( 'Tony Simons' );
$globals->default_maintainer_email_address( 'tony@aardvark.net' );
$globals->default_maintainer_email_screen_url_path( '/mailme' );
my $content = $globals->make_new_context();
$content->current_user_path_level( 1 );
$content->navigate_file_path( 'content' );
$content->set_prefs( 'content_prefs.pl' );
$content->call_component( 'CGI::Portable::AppSplitScreen' );
$globals->take_context_output( $content );
my $usage = $globals->make_new_context();
$usage->http_redirect_url( $globals->http_redirect_url() );
$usage->navigate_file_path( $globals->is_debug() ? 'usage_debug' : 'usage' );
$usage->set_prefs( '../usage_prefs.pl' );
$usage->call_component( 'DemoUsage' );
$globals->take_context_output( $usage, 1 );
if( $globals->is_debug() ) {
$globals->append_page_body( <<__endquote );
<p>Debugging is currently turned on.</p>
__endquote
}
$globals->search_and_replace_url_path_tokens( '__url_path__' );
$io->send_user_output( $globals );
1;
Please see the included demo called "website" for this file.
my $rh_preferences = {
email_logs => 1, # do we want to be sent daily reports?
fn_dcm => 'date_counts_mailed.txt', # our lock file to track mailings
mailing => [ # keep different types of reports in own emails
{
filenames => 'env.txt',
subject_unique => ' -- usage (env) to ',
}, {
filenames => 'site_vrp.txt',
subject_unique => ' -- usage (page views) to ',
}, {
filenames => 'redirect_urls.txt',
subject_unique => ' -- usage (external) to ',
}, {
filenames => [qw(
ref_urls.txt ref_se_urls.txt
ref_se_keywords.txt ref_discards.txt
)],
subject_unique => ' -- usage (references) to ',
erase_files => 1, # start over listing each day
},
],
env => { # what misc info do we want to know (low value distrib)
filename => 'env.txt',
var_list => [qw(
DOCUMENT_ROOT GATEWAY_INTERFACE HTTP_CONNECTION HTTP_HOST
REQUEST_METHOD SCRIPT_FILENAME SCRIPT_NAME SERVER_ADMIN
SERVER_NAME SERVER_PORT SERVER_PROTOCOL SERVER_SOFTWARE
)],
},
site => { # which pages on our own site are viewed?
filename => 'site_vrp.txt',
},
redirect => { # which of our external links are followed?
filename => 'redirect_urls.txt',
},
referrer => { # what sites are referring to us?
filename => 'ref_urls.txt', # normal websites go here
fn_search => 'ref_se_urls.txt', # search engines go here
fn_keywords => 'ref_se_keywords.txt', # their keywords go here
fn_discards => 'ref_discards.txt', # uris we filter out
discards => [qw( # filter uri's we want to ignore
^(?!http://)
deja
mail
)],
search_engines => { # match domain with query param holding keywords
alltheweb => 'query', # AllTheWeb
altavista => 'q', # Altavista
'aj.com' => 'ask', # Ask Jeeves
aol => 'query', # America Online
'ask.com' => 'ask', # Ask Jeeves
askjeeves => 'ask', # Ask Jeeves
'c4.com' => 'searchtext', # C4
'cs.com' => 'sterm', # CompuServe
dmoz => 'search', # Mozilla Open Directory
dogpile => 'q', # DogPile
excite => 's', # Excite
google => 'q', # Google
'goto.com' => 'keywords', # GoTo.com, Inc
'icq.com' => 'query', # ICQ
infogrid => 'search', # InfoGrid
intelliseek => 'queryterm', # "Infrastructure For Intelligent Portals"
iwon => 'searchfor', # I Won
looksmart => 'key', # LookSmart
lycos => 'query', # Lycos
mamma => 'query', # "Mother of Search Engines"
metacrawler => 'general', # MetaCrawler
msn => ['q','mt'], # Microsoft
nbci => 'keyword', # NBCi
netscape => 'search', # Netscape
ninemsn => 'q', # nine msn
northernlight => 'qr', # Northern Light Search
'search.com' => 'q', # CNET
'searchalot' => 'search', # SearchALot
snap => 'keyword', # Microsoft
webcrawler => 'search', # Webcrawler
yahoo => 'p', # Yahoo
},
},
};
This Perl 5 object class is part of a demonstration of CGI::Portable in use.
It is one of a set of "application components" that takes its settings and user
input through CGI::Portable and uses that class to send its user output.
This demo module set can be used together to implement a web site complete with
static html pages, e-mail forms, guest books, segmented text document display,
usage tracking, and url-forwarding. Of course, true to the intent of
CGI::Portable, each of the modules in this demo set can be used independantly
of the others.
This class does not export any functions or methods, so you need to call them
using object notation. This means using Class->function() for functions
and $object->method() for methods. If you are inheriting this class for
your own modules, then that often means something like $self->method().
You invoke this method to run the application component that is encapsulated by
this class. The required argument GLOBALS is an CGI::Portable object that
you have previously configured to hold the instance settings and user input for
this class. When this method returns then the encapsulated application will
have finished and you can get its user output from the CGI::Portable object.
Copyright (c) 1999-2004, Darren R. Duncan. All rights reserved. This module
is free software; you can redistribute it and/or modify it under the same terms
as Perl itself. However, I do request that this copyright information and
credits remain attached to the file. If you modify this module and
redistribute a changed version then please attach a note listing the
modifications. This module is available "as-is" and the author can not be held
accountable for any problems resulting from its use.
I am always interested in knowing how my work helps others, so if you put this
module to use in any of your own products or services then I would appreciate
(but not require) it if you send me the website url for said product or
service, so I know who you are. Also, if you make non-proprietary changes to
the module because it doesn't work the way you need, and you are willing to
make these freely available, then please send me a copy so that I can roll
desirable changes into the main release.
Address comments, suggestions, and bug reports to perl@DarrenDuncan.net.
perl(1), CGI::Portable, Net::SMTP, Fcntl, Symbol, CGI::Portable::AdapterCGI.