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

  use WWW::Blog::Identify "identify";

  my $flavor = identify( $url, $html );

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__