package Zeitgeist;

# $Id: Zeitgeist.pm,v 1.1 2006/03/25 08:45:20 daliblume Exp $
#
# Jim Flanagan <jimfl@tensegrity.net>
# 2003. Some Rights Reserved
#
# This work is licensed under the Creative Commons
# Attribution-ShareAlike License. To view a copy of this license, visit
# http://creativecommons.org/licenses/by-sa/1.0 or send a letter to Creative
# Commons, 559 Nathan Abbott Way, Stanford, California 94305, USA.

use FileHandle;
use URI;

use constant DEFAULTS => (
  size       => \&_size,
  separator  => q(&middot;),
  zcat       => '/bin/zcat',
  reflex     => q/zeitgeist/,
  refpos     => 1,
  targetpos  => 3
);

# ------------------------------------------------- sub new --

sub new {
  my $self   = bless { DEFAULTS }, shift;
  my %params = @_;

  for my $p (keys %params) { $self->{$p} = $params{$p} }
  return $self;
}

# -------------------------------------------- sub _readmap --

sub _readmap {
  my $ldir   = shift(@_);
  my $inFile = $ldir . "searchengines.txt";
  open(INFILE, $inFile) or die "_readmap can't open $inFile\n";
  while(<INFILE>) {
    if ( !/^#/ ) {  # If the lines does not start with the # character...
      chomp;
      ($host, $term, $count) = split;
      $Zeitgeist::eng::searchEngines{$host} = [ $term, $count ]; 
    }
  }
close INFILE;
}

# ------------------------------------------- sub _writemap --

sub _writemap {
  my $ldir   = shift(@_);
  my $inFile = $ldir . "searchengines.txt";
  open(INFILE, $inFile) or die "_writemap can't open $inFile\n";
  my $outFile = $ldir . "searchengines.out.txt";
  open(OUTFILE, ">$outFile") or die "_writemap can't open $outFile\n";
  while(<INFILE>) {
    if ( /^#/ ) {
      print OUTFILE $_;
    }
    else {
      chomp;
      ($host, $term, $count) = split;
	  if ($Zeitgeist::eng::searchEngines{$host}[1]) {
	    ++$count;
	  }
	  print OUTFILE "$host $term ", $count, "\n";
	}
  }
close OUTFILE;
close INFILE;
unlink $inFile;
rename ($outFile, $inFile);
}

# -------------------------------------------- sub readlogs --

sub readlogs { 
  my $self   = shift;
  my %params = @_;
  my $ldir = $self->{localdir};

  _readmap($ldir);

  eval {
    $self->_snarf($params{handle}) if $params{handle}->isa(FileHandle);
  };

  my $outFile = "searchengines.new.txt";
  open ( OUTFILE , ">" . $ldir . $outFile ) or die "readlogs can't open $outFile.\n";
  print OUTFILE "# This file is automatically generated by Zeitgeist.pm, sub readlogs()\n# The referrers here should be considered for addition to searchengines.txt\n#\n";
  for my $file (@{$params{files}}) {
    if ($file =~ /\.gz$/) {
      $self->_snarf(new FileHandle($self->{zcat} . " $file|")); }
    else {
      $self->_snarf(new FileHandle("<$file"));
    }
  }
  close OUTFILE;

  _writemap($ldir);
} 

# ---------------------------------------------- sub _snarf --

sub _snarf {
  my $self = shift;
  my $log  = shift;
  my %refs;
  my $thisdomain = $self->{thisdomain};

  while (<$log>) {
    my ($ref, $target) = (split)[$self->{refpos}, $self->{targetpos}];

    my $reflex = $self->{reflex};
    next if $ref =~ /$thisdomain/;
    next if $target =~ /$reflex/;
    next if $target =~ /referrers\.html/;
    next if $ref =~ /cache\:/;
    $ref =~ s/\[(.*)\]/$1/;
    $ref =~ s/^\"(.*)\"$/$1/;
    next if $ref eq '' or $ref eq '-';
    my $uri = new URI($ref);
    my $host = eval { $uri->host };
    my $path = eval { $uri->path };
    if ($Zeitgeist::eng::searchEngines{$host . $path}) { 
      %q = $uri->query_form;
      my $term = $q{$Zeitgeist::eng::searchEngines{$host . $path}[0]};
      $term =~ s/[\"]//g;
      $self->{uri}->{"\L$term"} = $target;
      $self->{searches}->{"\L$term"}++;
	  $Zeitgeist::eng::searchEngines{$host . $path}[1]++;
    }
	else {
	  print OUTFILE "$ref\n" if $ref =~ /search/;
	}
  }
}

# ----------------------------------------------- sub _size --

sub _size {
  my $size = shift;
  $size -= 2;
  my $odd = $size % 2;
  $size > 1 and $size -= $odd;
  return ($size, not $odd);
}

# ---------------------------------------------- sub toHTML --

sub toHTML {
  my $self = shift;
  my $f    = shift;
  my $zeit = undef;

  # Try it as a FileHandle First
  eval { 
    $zeit = $f if $f->isa(FileHandle);
  };

  # Okay, maybe it's a filename
  $zeit = new FileHandle("$f") unless defined $zeit;

  # No, well, nothing to be done then.
  return unless defined $zeit;

  # Read in the header if there is one
  if ($self->{header} && -e $self->{header}) {
    my $header = new FileHandle("<" . $self->{header});
    while (<$header>) { print $zeit $_ };
  }
  
  for my $search (sort {int(rand(2)) -1} keys %{$self->{searches}}) {
    my ($size, $bold) = $self->{size}->($self->{searches}->{$search});
    $size = ($size < 0 ? '' : '+') . $size;
    print $zeit '<a href="', $self->{uri}->{$search}, qq(" title=");
    print $zeit $self->{searches}->{$search}, ' hits">';
    print $zeit "<font ";
    $size != 0 and print $zeit qq(size="$size" );
    print $zeit 'color="#' . rcolor() . '">';
    $search =~ s/[\s\+]+/ /g;
    if ($bold) { $search = "<b>$search</b>" }
    print $zeit "$search";
    print $zeit q(</font></a> ), $self->{separator}, "\n";
  }
  
  # Footer
  if ($self->{footer} && -e $self->{footer}) {
    my $footer = new FileHandle("<" . $self->{footer});
    while (<$footer>) { print $zeit $_ };
  }
}

# ----------------------------------------------- sub toXML --

sub toXML {
  my $self  = shift;
  my $f     = shift;
  my $style = shift;
  my $xeit  = undef;
  
  # Try it as a FileHandle First
  eval { 
    $xeit = $f if $f->isa(FileHandle);
  };

  # Okay, maybe it's a filename
  $xeit = new FileHandle(">$f") unless defined $xeit;

  # No, well, nothing to be done then.
  return unless defined $xeit;

  print $xeit qq(<?xml version="1.0" encoding="ISO-8859-1"?>\n);

  if (defined $style) {
    print $xeit q(<?xml-stylesheet type="text/xsl" ), qq(href="$style"?>\n); }

  print $xeit "<zeitgeist>\n";

  for my $search (sort {int(rand(2)) -1} keys %{$self->{searches}}) {
    my $occurrences = $self->{searches}->{$search};
    my $uri = $self->{uri}->{$search};
    my $term = $search;
    $term =~ s/[\+]+/ /g;
    print $xeit "<search>\n";
    print $xeit qq(   <term occurrences="$occurrences"><![CDATA[$term]]></term>\n);
    print $xeit "   <uri><![CDATA[$uri]]></uri>\n";
    print $xeit "   <rcolor>" . rcolor() . "</rcolor>\n";
    print $xeit "</search>\n";
  }

  print $xeit "</zeitgeist>\n";
}

# ---------------------------------------------- sub rcolor --

sub rcolor {
  qw(00 33 66 99 cc ff)[int rand(4)] .
  qw(00 33 66 99 cc ff)[int rand(4)] .
  qw(00 33 66 99 cc ff)[int rand(4)] 
}

# ============================================ package Zeitgeist::eng ==

package Zeitgeist::eng;

%searchEngines = (
);

# ========================================= D O C U M E N T A T I O N ==

=pod 

=for HyPod
index: 1

=head1 NAME

Zeitgeist.pm - Generate a colorful HTML view of referrals from search engines.

=head1 SYNOPSIS

  use Zeitgeist;

  my $reflog = '/var/log/httpd/referer_log';
  my $zeitgeist = '/home/me/www/zeitgeist.html';
  my $z = new Zeitgeist();
  $z->readlogs( files => ["$reflog", "$reflog.1", "$reflog.2"] );
  $z->toHTML(">$zeitgeist");

=head1 DESCRIPTION

The C<Zeitgeist.pm> module can be used to read web server referer logs and
parse the referrals from search engines to get the search terms which led
people to your site. It then presents the search terms as HTML output
with each term randomly colored, and sized according to how many occurrences
of the term were found in the referer logs.

The HTML output is simple, and should probably be included into a frame
with server side includes.

Much of the text below will stubbornly spell referer as 'referer' and 
referral as 'referral'. Unless I goof up.

=head1 METHODS

=over 4

=item B<new()>

The constructor with no options sets the Zeitgeist instance up to work
with the idosyncratic nature of the author's site. These defaults can 
be changed in the C<Zeitgeist.pm> source file by modifying the C<DEFAULTS> 
constant.

They can be changed on an instance by instance basis by providing options
to the constructor. 

  $z = new( separator  => q( | ),
            zcat       => '/bin/zcat',
            size       => \&my_size_subroutine,
            reflex     => q/zeitgeist/,
            thisdomain => 'ghoti.net',
            refpos     => 1,
            targetpos  => 3 );

The C<separator> option controls what appears between
each term on the page. The C<zcat> option should be set to the path of the
zcat binary on your system if you want to automatically decompress log files.
(see the C<readlogs()> method below).

The C<reflex> option is used to filter out searches which found the zeitgeist
page itself. It should be set to a string that will match the path to your
zeitgeist page. Ig you don't finter these out, the zeitgeist page itself will
self-referentially spiral out of control, and the resulting singularity could
cause minor damage in the vicinity of your web server.

Similarly, the C<thisdomain> option should be set to your own domain, so that
the parser skips expensive pattern matching on internal referrals not likely
to be of interest.

The C<refpos> and C<targetpos> options are the fields in the referer log file
of the referer and the target page. The defaults are set up for a standard
Apache referer log. 

The C<size> option can be used to change the algorithm which computes the 
size of the font in the HTML output, and should be a referennce to a
subroutine which takes a single parameter, the number of occurrances of
the search term, and returns a list containing a number which will be used as the relative
size in the C<font> tag for the HTML output, and a boolean value determining
whether or not the entry should be bold.

=item B<readlogs()>

  $z->readlogs( file => ["file1", "file2", "file3.gz"] );
  $z->readlogs( handle => new FileHandle("/some/hideous/script |"));

The C<readlogs()> method will open multiple log files and parse the search
referral terms out of them. Currently all these files must have the same
format. If any of the filenames end in '.gz' they will be unzipped before
they are read.

For the sake of flexibility, you can also pass C<readlogs()> an already open
filehandle, which can be of some script that does more complex parsing.

You can use both the C<files> and C<handle> options in the same call to 
C<readlogs()>. Also, multiple calls to C<readlogs()> are cumulative; they won't
overwrite the data already loaded.

=item B<toHTML()>

  $z->toHTML($filename);
  $z->toHTML($filehandle);

The C<toHTML()> method writes the HTML to the specified file or already
open FileHandle object (or any subclass of FileHandle). If you pass
it a filename, than it is best that the user running the program have
permission to write that file. Similarly, if you pass a FileHandle object,
it should be opened for writing. This is all common sense, of course,
but I feel compelled to mention it for some reason.

Passing a filename will result in that file being overwritten. If you want
to append to the file, open your own FileHandle and pass that in. You can use
the FileHandle mode to pass the HTML to some other program.

=item B<toXML()>

  $z->toXML($filename);
  $z->toXML($filehandle);
  $z->toXML($filename, $stylesheet);

The C<toXML()> method is just like the C<toHTML()> method, except that it
produces an XML format of the data, which can then be munged with XSLT into
whatever sort of HTML you like. The basic format of the XML file is

  <?xml version="1.0" encoding="ISO-8859-1"?>
  <?xml-stylesheet type="text/xsl" href="zeitgeist.xsl.xslt"?>
  <zeitgeist>
  <search>
     <term occurrences="1"><![CDATA[suv bumper sticker]]></term>
     <uri><![CDATA[http://www.google.com/search?q=suv+bumper+sticker]]></uri>
     <rcolor>990000</rcolor>
  </search>
  <!-- Multiple search entries -->
  </zeitgeist>

If a second argument is provided to the C<toXML()> method, this is treated
as the location of an XSL stylesheet, which will be referenced in the 
XML output.

=back

=head1 AUTHOR

Jim Flanagan <jimfl@tensegrity.net>

=cut

W007

#PLCK: /tmp/plck28857 syntax OK

