package WWW::Blog::Identify;

use strict;
use warnings;

require Exporter;
 
our @ISA = qw(Exporter);
our @EXPORT_OK = qw/identify/;


our $VERSION = '0.06';


sub identify {
	my ($url, $text) = @_; 
	
	$url = lc( $url ); 
	local $_ = $url;
	
	# patterns ordered roughly in terms of frequency


	#
	# 	URL CHECKING
	#
	
	return "blogspot" if /\.blogspot\.com/o;
	return "blogger" if m|\.blogger\.com/|o;
	
	return "blogger (br)" if  m|\.blogger\.com\.br|o; # Brazilian Blogger
	return 'terra' if  m|weblogger\.(terra\.)?com\.br/|o;
	return "diaryland" if  /\.diaryland\./o;
	return "livejournal" if  /\.livejournal\.com/o;
	return "journalspace" if  /\.journalspace\.com/o;
	return "blogalia" if  /\.blogalia\.com/o;
	return "pitas" if  /\.pitas\.com/o;
	return "persianblog" if  /\.persianblog\.com/o; # Farsi
	return "persianlog" if  /\bpersianlog\.com/o;  # Farsi
	return "diaryhub" if  /\.diaryhub\.(?:com|net)\/?$/io; # Thai
	
	return "radio" if  /radio.weblogs\.com/o;
	return "radio" if /blogs.law.harvard.edu/o;
	return "radio" if /\.blogs.it\b/o;	
	
	return "manila" if  /\.manilasites\.com/o;
	return "manila" if  /\.editthispage\.com/o;
	return "manila" if  m|\.weblogger\.com/|o;
	return "manila" if  m|\.weblogs\.com/|o;
	
 	return "20six" if m|\.20six\.|o;
 	return "typepad" if m|\.typepad\.|o;
	
	return "twoday" if  /\.twoday\.net/o;
	return "salon" if  /blogs\.salon\.com/o;
	return "splinder" if  /\.splinder\.it/o;		# Italy
	return "diarist" if  /\.diarist\.com/o;
	return "antville" if  /\.antville\.org/o;
	return 'bloggingnetwork' if  m|\.bloggingnetwork\.com/blogs|o;
	return "crimsonblog" if  /\.crimsonblog\./o;
	return "skyblog" if  /\.skyblog\.com/o;	# French
	
	return "blog.pl (polish)" if  /\.blog\.pl/o;
	return "e-blog.pl (polish)" if  /\.e-blog\.pl/o;
	return "weblog.pl (polish)" if  /\.weblog\.pl/o;
	
	return "twoday" if  /\.twoday\.net/o;
	return "monblogue" if  /\.monblogue\.com/o;
	return 'joueb' if  m|joueb\.com/|o;				# France
	return 'blogstudio' if  m|\.blogstudio\.com/|o;
	return 'blog-city' if  m|blog-city\.com/|o;
	return 'blogsky' if  m|\.blogsky\.com/|o;		# English and Persian
	return 'u-blog' if  m|u-blog\.net/|o;	 		# France
	return 'barrapunto' if  m|\bbarrapunto\.com/index\.pl|o;	# Spain
	return 'blig' if  m|\.blig\.(?:ig.)?com\.br|o;	# Brazil
	return 'g-blog' if  m|g-blog\.net/|o;
	return 'babelogue' if m|babelogue\.citypages\.com|io;
	return 'jevon' if m|\.jevon\.org/|io;
	return 'tripod' if m|\.tripod\.com/|io;
	
	return 'xanga' if m|\.xanga\.com|o;
	#
	#	 CONTENT CHECKING
	#

	local $_ = $text;
	
	# First, check META tags
	
	return "postnuke" if m|CONTENT="Post-?Nuke|io;	# Nuke is nice enough to use META tags
	return "php-nuke" if m|CONTENT="PHP-?Nuke|io;
	return "microsoft" if m|<meta[^>]+Content=['"]Microsoft Visual|io;
	return "nucleus" if m|<meta[^>]+content=['"]Nucleus|io;
	return "greymatter" if m|<meta[^>]+content=['"]Greymatter|io;
	return "land down under" if m|<meta[^>]+content=['"]Land Down Under|io;
	
	# Next, check actual content
	
	return "movable type" if m|cgi-bin/mt|o;
	return "movable type" if m|Powered by.*Move?able ?Type|io; # common typo is 'Moveable'
	return "movable type" if m|mtblog.gif|io;
	return "movable type" if m|move?abletype.gif|o;
	return "movable type" if m!function Open(Trackback|Comments)\s+\(c\)!o; # default MT JavaScript

	return "blogger pro" if m|powered_by_blogger_pro[0-9]*\.gif|io;
	return "blogger pro" if m|powered by:? <a href="[^>]+>blogger pro</a>|io;
		
	return "blogger" if m|bloggerbutton[0-9]+.gif|io;
	return "blogger" if m|bloggertemplate[^.]+.gif|io;
	return "blogger" if m|blogger_bluelong.gif|o;
	return "blogger" if m|powered by (<a href="[^>]+>)?blogger(</a>)?|io;
	
	return "radio" if m|img src="http://radio.weblogs.com|io;
	return "radio" if m|http://radio.xmlstoragesystem.com/weblogStats|oi;
	return "radio" if m|images/radioUserLand|oi;
	return "radio" if m|xmlCoffeeCup|oi;
	
	return "manila" if m|thisIsAManilaSite|oi;
	
	return "cafelog" if m!function b2(?:open|comment)!o;	# default cafelog JavaScript
	return "cafelog" if m|powered by (<a href="[^>]+)?b2|io;
	
	return "pivot" if m|<!-- Created with Pivot [0-9.]+ -->|io;
	return "pivot" if m|pivot-?banner[^.]*.gif|io;
	
	return "textpattern" if m|txp_slug|o;
	return "blosxom" if /blosxom\.gif/o;
	
	return "slogger" if /Created by Slogger/io;
	
	return "greymatter" if /gm-icon.gif/o;
	return "greymatter" if /Powered by Greymatter/io;
	
	return "pMachine" if m|alt="[^"]+ pMachine|io; # This can be "Powered by" or "Gemaakt mit", for example
	return "pMachine" if m|powered by (?:<a href="[^>]+>)?pMachine|io;
	return "pMachine" if m|pmachine.gif|io;
	
	return "psychoblogger" if m|Powered by (?:<a [^>]+>)?Psychoblogger|io;
	return "WebCrimson" if m|Powered by (?:<a [^>]+>)?WebCrimson|io;
	
	# Tests of last resort
	my @blog_count = $text =~ /\bblog\b/gi;
	
	return "suspected by URL" if $url =~ /[\W\-_](?:we)?blog/o;
	return "suspected by URL" if $url =~ /\bbitacoras\b/i;
	return "suspected by rss" if $text =~ /\brss\b/i;
	return "suspected by content" if scalar @blog_count > 5;
	
	return;
	
}

1;

__END__


=head1 NAME

WWW::Blog::Identify - Identify blogging tools based on  URL and content

=head1 SYNOPSIS

  use WWW::Blog::Identify "identify";
  
  my $flavor = identify( $url, $html );
  
=head1 FUNCTIONS

=over

=item identify URL, HTML

Attempts to identify the blog based on an examination of the URL and content. Returns undef if
all tests fail, otherwise returns a guess as to the blog 'flavor'.


=head1 DESCRIPTION

This is a heuristic module for identifying weblogs based on their URL and content.
The module is a compilation of identifying patterns observed in the wild, for a variety
of blogging tools and providers worldwide.   You can read a full list of blogs represented
in the README.  Please email the author if you have a blogging engine you would like
added to the detector.

The module first checks the URL for common blog hosts (BlogSpot, Userland, Persianblog, etc.)
and returns immediately if it can find a match.  Failing that,  it will look through the blog HTML for distinctive markers (such as "powered by" images)
or META generator tags.   As a last resort, it will test to see if the page contains
an RSS feed, or has the word 'blog' in it repeated at least five times. 

The philosophy of this module is to favor false negatives over false positives.  If you
are a blog tool author, you can vastly improve the detection rate simply by using a generator
tag in your default template, like this:

E<lt>meta name="generator" content="myBlogTool 0.01" /E<gt>

This module is in active use on a large blog index, so I'll try to keep it reasonably 
up to date.

=head2 EXPORT

None by default.  You can export 'identify' out into your namespace if you like.


=head1 AUTHOR

Maciej Ceglowski, E<lt>developer@ceglowski.comE<gt>

=head1 COPYRIGHT

(c) 2003  Maciej Ceglowski

This module is distributed under the same license as Perl itself.

=cut