# -*- perl -*-
# Blosxom Plugin: tagging
# Author(s): Axel Beckert <blosxom@deuxchevaux.org>, http://noone.org/blog
# Version: 0.03
# Licensing: GPL v2 or newer, http://www.gnu.org/licenses/gpl.txt
# Tagging web page: http://noone.org/blog?-tags=Tagging
# Tagging download: http://noone.org/blosxom/tagging
# Blosxom web page: http://www.blosxom.com/

### Documentation:
#
# This is a plugin for blosxom.
#
# Installation:
#
#  Just drop it into your blosxoms plugin directory and it should start
#  working. If you want, change some of the configuration variables
#  below.
# 
# What it does:
#
#  It allows you to tag Blosxom postings with keywords, filter
#  postings based on that tags and show how often which tag was
#  used. Should work together with Technorati Tags as described on
#  http://www.technorati.com/help/tags.html although this feature is
#  yet untested. (Feedback regarding this and other features is
#  welcome!)
#
# How to use it:
#
#  Add an additional line after the title, starting with "Tags:".
#  Between this Tag line and the body text there should be a blank
#  line. (This is in conformance with other Plugins, e.g. the one for
#  meta tags, which work the same way.)
#
#  Use $tagging::tag_list for the story tag list,
#  $tagging::global_tag_list for a global tag list (also called tag
#  cloud, e.g for head.html or foot.html) and $tagging::current_filter
#  for the currently used tagging filter (if any)
#
# Known Bugs:
#
#  + Being not as performant as I would like it to be.
#  + Related stories are not sorted by recentness when having same
#    number of shared tags.
#
# Version History:
#
#  0.01:   Initial release, based on Rael Dornfest's meta plugin.
#  0.01.1: Additional documentation, small compatibility fix for newer
#          Perl versions
#  0.02:   Showing how often a tag has been used (in 3 different ways)
#  0.02.1: Fixed an XSS issue
#  0.02.2: Fixed documentation (removed multcat left-overs) and simple
#          Technorati Tag support, see http://www.technorati.com/help/tags.html
#  0.03: New feature: related stories based on the already given tags
#        (Idea by Wim de Jonge)
#

package tagging;

use File::Basename;
use CGI;

###
### Config
###

# Regular expressions

my $tag_re = qr/Tags:\s*/i;
my $split_re = qr/\s*,\s*/;

# Texts for tags

my $tag_prefix = 'Tagged as: ';
my $tag_suffix = ''; #' &raquo; ';
my $global_tag_prefix = '<p style="text-align: justify;">'; # '<p>Available tags: ';
my $global_tag_suffix = '</p>';
my $current_filter_prefix = '<p>Current filter: &raquo;';
my $current_filter_suffix = '&laquo;</p>';

# Displaying the tag cloud 

my $min_tag_no = 2;
my $show_tag_no = 0;
my $show_tag_no_by_size = 1;
my $show_tag_no_by_color = 1;
my $max_size = 250;
my $min_size = 75;

my $start_color = 'ff9900';
my $end_color = '991100';
#my $start_color = '0000ff';
#my $end_color = 'ff0000';
#my $start_color = 'ff9900';
#my $end_color = '0000ff';

# Texts for related stories

my @related_tags_blacklist = ('Now Playing', 'Other Blogs');

my $min_relations = 2;
my $max_related_stories = 7;
my $show_related_tags = 1;

my $related_stories_prefix = '<div class="blosxomstoryfoot" align="left"><h4 class="related_stories">Related stories</h4><ul class="related_stories">'."\n";
my $related_stories_suffix = "\n</ul></div>\n";
my $related_story_join     = "\n";
my $related_story_prefix   = '<li class="related_stories">';
my $related_story_suffix   = '</li>';
my $related_class          = 'related_stories';

my $shared_tags = 'Shared tags: ';

###
### Init (You can use these variables in templates prefixed with "$tagging::".)
###

$tag_list = '';
$global_tag_list = '';
$current_filter = '';
$related_stories = '';
%tags = ();

sub start { 
1;
}

sub story {
    my($pkg, $path, $filename, $story_ref, $title_ref, $body_ref) = @_;
    my %localtags = ();
    my $body = '';
    my $in_header = 1;

    foreach (split /\n/, $$body_ref) {
	if (/^\s*$/) {
	    $in_header = 0;
	    $body .= "$_\n";
	    next;
	}

	if ($in_header) {
	    foreach my $tag (split($split_re, (m!^$tag_re(.+?)$!)[0])) {
		$localtags{$tag} = 1;
	    }
	    next;
	}

	$body .= "$_\n";
    }
    $$body_ref = $body;

    $tag_list = '';
    my %other_stories = ();
    foreach my $tag (sort { lc($a) cmp lc($b) } keys %localtags) {
	$tag_list .= qq! <a href="$blosxom::url?-tags=$tag" rel="tag">$tag</a>,!;
        # Looking for similar stories
	next if grep { $_ eq $tag } @related_tags_blacklist;
	foreach my $other (@{$tags{$tag}}) {
	    next if $other eq "$blosxom::datadir$path/$filename.$blosxom::file_extension";
	    if (exists $other_stories{$other}) {
		push(@{$other_stories{$other}}, $tag);
	    } else {
		$other_stories{$other} = [$tag];
	    }
	}
    }
    $tag_list =~ s/,$//;
    $tag_list = "$tag_prefix$tag_list $tag_suffix" if $tag_list;

    $related_stories = '';
    my $i = 0;
    foreach my $other (sort { scalar @{$other_stories{$b}} <=> 
			      scalar @{$other_stories{$a}} }
		       keys %other_stories) {
	last if scalar(@{$other_stories{$other}}) < $min_relations;
	last if $i++ >= $max_related_stories;

	$related_stories .= $related_story_join if $related_stories;

	my $opath = $other;
	$opath =~ s!\Q$blosxom::datadir/\E!$blosxom::url!;
	$opath =~ s!\Q$blosxom::file_extension\E$!$blosxom::default_flavour!;

	my $title = $other;
	$title =~ s!^.*/([^/]+)\.$blosxom::file_extension$!$1!;

	$related_stories .= qq($related_story_prefix<a href="$opath" class="$related_class">$title</a>);

	$related_stories .= ' ('.$shared_tags.join(', ', @{$other_stories{$other}}).')'
	    if $show_related_tags;

	#use Data::Dumper;
	#$related_stories .= qw|$other: |.Dumper($other_stories{$other});

	$related_stories .= $related_story_suffix;
    }
    $related_stories = "$related_stories_prefix$related_stories$related_stories_suffix" if $related_stories;


    return 1;
}

sub filter {
    my ($pkg, $files_ref) = @_;
    my $filter_tags = CGI::param('-tags');
    $filter_tags =~ s/</[/gs; # No XSS here
    $filter_tags =~ s/>/]/gs; # No XSS here

#    my %tags = ();

    foreach my $key (keys %$files_ref) {
	next if -l $key;
	open(FILE, $key) or do { warn "Can't open $key: $!"; next; };
	my $tags_found = 0;
	my $empty_line_found = 0;
	while ($_ = <FILE>) {
	    last if /^\s*$/;
	    if (m!^$tag_re(.+?)$!) {
		foreach my $tag (split($split_re, $1)) {
		    if (ref $tags{$tag}) {
			push(@{$tags{$tag}}, $key);
		    } else {
			$tags{$tag} = [$key];
		    }
		}
	    }
	}
    }

    my $max = 1;
    my $min = $min_tag_no;
    foreach my $list (values %tags) {
	my $no = scalar @$list;
	next if $no < $min_tag_no;
	$max = $no if $max < $no;
	$min = $no if $min > $no || !$min;
    }

    my $diff = $max - $min;

    foreach my $tag (sort { lc($a) cmp lc($b) } keys %tags) {
	(my $url_tag = $tag) =~ s/\&/\%26/g;
	(my $html_tag = $tag) =~ s/\&/\&amp;/g;
	my $tag_no = scalar @{$tags{$tag}};
	next if $tag_no < $min_tag_no;
	my $tag_no_display = $show_tag_no ? " ($tag_no)" : '';
	my $title = $tag_no == 1 ? "1 posting tagged" : "$tag_no postings tagged";
	my $tag_percent = $diff ? int($min_size+((($max_size-$min_size)/$diff)*($tag_no-$min+1))) : 100;
	my $color = $diff ? &color_calc($tag_no, $min, $max) : '';
	my $style = '';
	$style .= qq!font-size: $tag_percent%;! if $show_tag_no_by_size && $diff;
	$style .= qq!color: #$color;! if $show_tag_no_by_color && $diff;
	$global_tag_list .= qq| <a href="$blosxom::url?-tags=$tag" title="$title" style="$style">$tag</a>$tag_no_display,\n|;
    }

    $global_tag_list =~ s/,$//;
    $global_tag_list = "$global_tag_prefix$global_tag_list$global_tag_suffix" 
	if $global_tag_list;

    return 1 unless $filter_tags;

    my @tags = split($split_re, $filter_tags);
    my %localfiles = ();
    foreach my $tag (@tags) {
	my $files = $tags{$tag};
	next unless ref $files;
	foreach my $file (@$files) {
	    $localfiles{$file} = $files_ref->{$file};
	}
    }

    %$files_ref = %localfiles;

    $current_filter = ($current_filter_prefix.
		       join(', ', 
			    map { s/\&/\&amp;/g; $_; } 
			    sort { lc($a) cmp lc($b) } 
			    @tags).
		       $current_filter_suffix);

#    use Data::Dumper;
#    $debug = Dumper $filter_tags, $files_ref, \@tags, \%localfiles, \%tags;

    1;
}

sub color_calc {
    my ($tag_no, $min, $max) = @_;
    my $diff = $max - $min;

    my $result = [];

    foreach my $i (0..2) {
	my $s = &get_dec($start_color, $i*2);
	my $e = &get_dec($end_color, $i*2);
	my $diff_se = abs($s-$e);

	my $rogob = ($diff_se/$diff)*($tag_no-$min);
	$rogob = int($s < $e ? $s + $rogob : $s - $rogob);
	$result->[$i] = sprintf('%02x', $rogob);
    }

    #use Data::Dumper;
    return join('', @$result);
}

sub get_dec {
    my ($color, $offset) = @_;
    return hex(substr($color, $offset, 2));
}

1;