xtaran/tagging

   1 # -*- perl -*-
   2 # Blosxom Plugin: tagging
   3 # Author(s): Axel Beckert <blosxom@deuxchevaux.org>, http://noone.org/blog
   4 # Version: 0.04
   5 # Licensing: GPL v2 or newer, http://www.gnu.org/licenses/gpl.txt
   6 # Tagging plugin web page: http://noone.org/blog?-tags=Tagging
   7 # Tagging plugin download: http://noone.org/blosxom/tagging
   8 # Blosxom web page: http://blosxom.ookee.com/
   9
  10 ### Documentation:
  11 #
  12 # This is a plugin for blosxom.
  13 #
  14 # Installation:
  15 #
  16 #  Just drop it into your blosxoms plugin directory and it should start
  17 #  working. If you want, change some of the configuration variables
  18 #  below.
  19 #
  20 # What it does:
  21 #
  22 #  It allows you to tag Blosxom postings with keywords, filter
  23 #  postings based on that tags and show how often which tag was
  24 #  used. Should work together with Technorati Tags as described on
  25 #  http://www.technorati.com/help/tags.html although this feature is
  26 #  yet untested. (Feedback regarding this and other features is
  27 #  welcome!)
  28 #
  29 # Configuration:
  30 #
  31 #  The only configuration option which may be necessary to make the
  32 #  tag cloud work with very less stories or very less tags, is
  33 #  $min_tag_no. Set it to 1 and you see every tag you every tag you
  34 #  used in the cloud. Set it to higher values, if you have a lot of
  35 #  tags in use. YMMV.
  36 #
  37 #  The same counts for the related stories and
  38 #  $min_story_relations. By default, a story is seen as related if it
  39 #  shares at least two tags with the current story. Set it to 1, if
  40 #  you want to use it with not so many tags or stories.
  41 #
  42 # How to use it:
  43 #
  44 #  Add an additional line after the title, starting with "Tags:".
  45 #  Between this Tag line and the body text there should be a blank
  46 #  line. (This is in conformance with other Plugins, e.g. the one for
  47 #  meta tags, which work the same way.) After this keyword, the tags
  48 #  should be listed and separated by commata.
  49 #
  50 # Examples:
  51 #
  52 #  The follwing two examples have the same effect.
  53 #
  54 #  | Story Headline
  55 #  | Tags: X, Y, Z
  56 #  | Tags: A, B, C
  57 #  |
  58 #  | Story Body [...]
  59 #
  60 #  | Story Headline
  61 #  | Tags: A, X, B, Y, C, Z
  62 #  |
  63 #  | Story Body [...]
  64 #
  65 # Including the tags into templates:
  66 #
  67 #  Use $tagging::tag_list for the story tag list,
  68 #  $tagging::global_tag_list for a global tag list (also called tag
  69 #  cloud, e.g for head.html or foot.html), $tagging::current_filter
  70 #  for the currently used tagging filter (if any) and
  71 #  $tagging::related_tags for a list of tags related to the current
  72 #  filter.
  73 #
  74 # Filtering by tags:
  75 #
  76 #  If you want to filter by tags, append a CGI parameter named "-tags"
  77 #  with a comma-seperated list of tags to the URL of the blog. By
  78 #  default any post having at least one of the tags will be shown. If
  79 #  you set the CGI parameter "-conj" to "and", only posts with all of
  80 #  the tags will be shown.
  81 #
  82 #  Technorati don't seem to accept URLs with tag names in the query
  83 #  string as tagref URLs, so with the following Apache configuration,
  84 #  you can do technorati accepted tagref URLs:
  85 #
  86 #     RewriteEngine On
  87 #     RewriteRule ^/cgi-bin/blosxom.cgi/tags/(.*)$ /cgi-bin/blosxom.cgi?-tags=$1 [PT]
  88 #
  89 #  Then you can use the prefined blosxom_tags as base URL for tag links.
  90 #
  91 #  Another, less performant but simplier option is to install the
  92 #  plugin pathbasedtagging, available at
  93 #  http://noone.org/blosxom/pathbasedtagging
  94 #
  95 # Examples:
  96 #
  97 #  http://blog/cgi-bin/blosxom.cgi?-tags=X,Y,Z will show you all
  98 #  posts which have at least one of the tags X, Y _or_ Z.
  99 #
 100 #  http://blog/cgi-bin/blosxom.cgi?-tags=X,Y,Z&-conj=and will show
 101 #  you all posts which have _all_ of the tags X, Y _and_ Z.
 102 #
 103 # Known bugs and other ugly obstacles:
 104 #
 105 #  + Being not as performant as I would like it to be, especially when
 106 #    using -conj=and.
 107 #  + Related stories are not sorted by recentness when having same
 108 #    number of shared tags.
 109 #  + Tags must be written without HTML entities.
 110 #  + Technorati style tags currently don't work well in the tag cloud.
 111 #
 112 # Version History:
 113 #
 114 #  0.01:   Initial release, based on Rael Dornfest's meta plugin.
 115 #  0.01.1: Additional documentation, small compatibility fix for newer
 116 #          Perl versions
 117 #  0.02:   Showing how often a tag has been used (in 3 different ways)
 118 #  0.02.1: Fixed an XSS issue
 119 #  0.02.2: Fixed documentation (removed multcat left-overs) and simple
 120 #          Technorati Tag support, see http://www.technorati.com/help/tags.html
 121 #  0.03:   New feature: related stories based on the already given tags
 122 #          (Idea by Wim de Jonge)
 123 #  0.03.1: Bugfix release: Missing "/" and some minor issues
 124 #  0.04:   Tag blacklist for tag cloud (suggestion by Wim), boolean
 125 #          "and" conjunction for filtering with several tags, linked
 126 #          current filter, related tags, option to link to technorati
 127 #          tags instead of own tags, several bugfixes (Thanks to Wim
 128 #          and blathijs!), added a lot of documentation, renamed some
 129 #          config variables to have more consistent names
 130 #
 131 # TODO LIST:
 132 #
 133 #  + Generalise $base_url{wikipedia_XX}, maybe with tie.
 134 #  + Option to accept case insensitiv tags
 135 #  + Option to link all tags in lower case
 136 #
 137
 138 package tagging;
 139
 140 use File::Basename;
 141 use CGI;
 142
 143 ###
 144 ### Config
 145 ###
 146
 147 # Where to link story tags (URLs defined below)
 148 our $link_tag = 'blosxom' unless defined $link_tag;
 149
 150 # Where to link tags in the tag cloud (URLs defined below)
 151 our $link_cloud = 'blosxom' unless defined $link_cloud;
 152
 153 # Where to link related tags (URLs defined below)
 154 our $link_rtag = 'blosxom' unless defined $link_rtag;
 155
 156 our %base_url = (
 157                 blosxom => "$blosxom::url?-tags=",
 158                 blosxom_tags => "$blosxom::url/tags/",
 159                 technorati => "http://www.technorati.com/tags/",
 160                 flickr => "http://flickr.com/photos/tags/",
 161                 delicious => 'http://del.icio.us/tag/',
 162                 delicious_popular => 'http://del.icio.us/popular/',
 163                 delirious => 'http://de.lirio.us/rubric/entries/tags/',
 164                 suprcilious => 'http://supr.c.ilio.us/tag/',
 165                 buzznet => 'http://www.buzznet.com/buzzwords/',
 166                 shadows => 'http://www.shadows.com/tags/',
 167                 wikipedia => "http://en.wikipedia.org/wiki/",
 168                 wikipedia_de => "http://de.wikipedia.org/wiki/",
 169                 wikipedia_fr => "http://fr.wikipedia.org/wiki/",
 170                 wikipedia_pl => "http://pl.wikipedia.org/wiki/",
 171                 wikipedia_ja => "http://ja.wikipedia.org/wiki/",
 172                 wikipedia_nl => "http://nl.wikipedia.org/wiki/",
 173                 wikipedia_it => "http://it.wikipedia.org/wiki/",
 174                 wikipedia_sv => "http://sv.wikipedia.org/wiki/",
 175                 wikipedia_pt => "http://pt.wikipedia.org/wiki/",
 176                 wikipedia_es => "http://es.wikipedia.org/wiki/",
 177                 wikipedia_da => "http://da.wikipedia.org/wiki/",
 178                 wikipedia_hu => "http://hu.wikipedia.org/wiki/",
 179                 wikipedia_no => "http://no.wikipedia.org/wiki/",
 180                 wikipedia_nn => "http://nn.wikipedia.org/wiki/",
 181                 wikipedia_lb => "http://lb.wikipedia.org/wiki/",
 182                 wikipedia_simple => "http://simple.wikipedia.org/wiki/",
 183                 ) unless defined %base_url;
 184
 185 # Regular expressions
 186
 187 our $tag_re = qr/Tags:\s*/i unless defined $tag_re;
 188 our $split_re = qr/\s*,\s*/ unless defined $split_re;
 189
 190 # Texts for tags
 191
 192 our $tag_prefix = 'Tagged as: ' unless defined $tag_prefix;
 193 our $tag_suffix = '' unless defined $tag_suffix; #' &raquo; '
 194 our $global_tag_prefix = '<p style="text-align: justify;">' unless defined $global_tag_prefix; # '<p>Available tags: '
 195 our $global_tag_suffix = '</p>' unless defined $global_tag_suffix;
 196 our $current_filter_prefix = '<p><em>Current filter:</em> &raquo;' unless defined $current_filter_prefix;
 197 our $current_filter_suffix = '&laquo; (Click tag to exclude it or click a conjunction to switch them.)</p>' unless defined $current_filter_suffix;
 198
 199 # Displaying the tag cloud
 200
 201 our $min_tag_no = 2 unless defined $min_tag_no;
 202 our $show_tag_no = 0 unless defined $show_tag_no;
 203 our $show_tag_no_by_size = 1 unless defined $show_tag_no_by_size;
 204 our $show_tag_no_by_color = 1 unless defined $show_tag_no_by_color;
 205 our $max_size = 250 unless defined $max_size;
 206 our $min_size = 75 unless defined $min_size;
 207
 208 our @tag_cloud_blacklist = ('Now Playing', 'Other Blogs', 'Screenshot') unless defined @tag_cloud_blacklist;
 209
 210 our $start_color = 'ff9900' unless defined $start_color;
 211 our $end_color = '991100' unless defined $end_color;
 212 #our $start_color = '0000ff' unless defined $start_color;
 213 #our $end_color = 'ff0000' unless defined $end_color;
 214 #our $start_color = 'ff9900' unless defined $start_color;
 215 #our $end_color = '0000ff' unless defined $end_color;
 216
 217 # Texts for related stories
 218
 219 our @related_stories_tag_blacklist = ('Now Playing', 'Other Blogs', 'Screenshot') unless defined @related_stories_tag_blacklist;
 220
 221 our $min_story_relations = 2 unless defined $min_story_relations;
 222 our $max_related_stories = 5 unless defined $max_related_stories;
 223 our $show_shared_tags = 0 unless defined $show_shared_tags;
 224 our $show_number_of_shared_tags = 1 unless defined $show_number_of_shared_tags;
 225
 226 our $related_stories_prefix = '<div class="blosxomstoryfoot" align="left"><h4 class="related_stories">Related stories</h4><ul class="related_stories">'."\n" unless defined $related_stories_prefix;
 227 our $related_stories_suffix = "\n</ul></div>\n" unless defined $related_stories_suffix;
 228 our $related_story_join     = "\n" unless defined $related_story_join;
 229 our $related_story_prefix   = '<li class="related_stories">' unless defined $related_story_prefix;
 230 our $related_story_suffix   = '</li>' unless defined $related_story_suffix;
 231 our $related_story_class    = 'related_stories' unless defined $related_story_class;
 232
 233 our $shared_tags_text = 'shared tags' unless defined $shared_tags_text;
 234
 235 # Related Tags
 236
 237 our $min_tag_relations = 2 unless defined $min_tag_relations;
 238 our $max_related_tags = 5 unless defined $max_related_tags; # 0 to disable
 239 our $show_tag_shares = 0 unless defined $show_tag_shares;
 240
 241 our @related_tags_tag_blacklist = ('Now Playing', 'Other Blogs', 'Screenshot') unless defined @related_tags_tag_blacklist;
 242
 243 our $related_tags_prefix = '<p class="related_tags"><em>Related tags:</em> ' unless defined $related_tags_prefix;
 244 our $related_tags_suffix = "\n</p>\n" unless defined $related_tags_suffix;
 245 our $related_tag_join     = ", " unless defined $related_tag_join;
 246 our $related_tag_class    = 'related_tags' unless defined $related_tag_class;
 247
 248 ###
 249 ### Init (You can use these variables in templates prefixed with "$tagging::".)
 250 ###
 251
 252 $tag_list = '';
 253 $global_tag_list = '';
 254 $current_filter = '';
 255 $current_filter_short = '';
 256 $related_stories = '';
 257 $related_tags = '';
 258
 259 %tags = ();
 260 %related_tags = ();
 261
 262 sub start {
 263     1;
 264 }
 265
 266 sub story {
 267     my($pkg, $path, $filename, $story_ref, $title_ref, $body_ref) = @_;
 268     my %localtags = ();
 269     my $body = '';
 270     my $in_header = 1;
 271
 272     foreach (split /\n/, $$body_ref) {
 273         if (/^\s*$/) {
 274             $in_header = 0;
 275             $body .= "$_\n";
 276             next;
 277         }
 278
 279         if ($in_header && /^$tag_re(.+?)$/) {
 280             foreach my $tag (split($split_re, $1)) {
 281                 $localtags{$tag} = 1;
 282             }
 283             next;
 284         }
 285
 286         $body .= "$_\n";
 287     }
 288     $$body_ref = $body;
 289
 290     $tag_list = '';
 291     my %other_stories = ();
 292     foreach my $tag (sort { lc($a) cmp lc($b) } keys %localtags) {
 293         $tag_list .= " " . make_tag_link($link_tag, $tag, (rel => "tag")) . ",";
 294
 295 #       $tag_list .= qq! <a href="$base_url{blosxom}$tag&-technorati-hack=/$tag" rel="tag" title="Look for tag $tag in this blog"!.($invisible_plugin_tags ? qq! style="display:none;"! : '').qq!>$tag</a>! if $add_plugin_tags;
 296
 297         # Looking for similar stories
 298         next if grep { $_ eq $tag } @related_stories_tag_blacklist;
 299         foreach my $other (@{$tags{$tag}}) {
 300             next if $other eq "$blosxom::datadir$path/$filename.$blosxom::file_extension";
 301             if (exists $other_stories{$other}) {
 302                 push(@{$other_stories{$other}}, $tag);
 303             } else {
 304                 $other_stories{$other} = [$tag];
 305             }
 306         }
 307     }
 308     $tag_list =~ s/,$//;
 309     $tag_list = "$tag_prefix$tag_list $tag_suffix" if $tag_list;
 310
 311     $related_stories = '';
 312     my $i = 0;
 313     foreach my $other (sort { scalar @{$other_stories{$b}} <=>
 314                               scalar @{$other_stories{$a}} }
 315                        keys %other_stories) {
 316         last if scalar(@{$other_stories{$other}}) < $min_story_relations;
 317         last if $i++ >= $max_related_stories;
 318
 319         $related_stories .= $related_story_join if $related_stories;
 320
 321         my $opath = $other;
 322         $opath =~ s!\Q$blosxom::datadir\E!$blosxom::url!;
 323         $opath =~ s!\Q$blosxom::file_extension\E$!$blosxom::default_flavour!;
 324
 325         my $title = $other;
 326         $title =~ s!^.*/([^/]+)\.$blosxom::file_extension$!$1!;
 327
 328         my $shared_tags_list = join(', ', @{$other_stories{$other}});
 329         my $shared_tags_number = scalar(@{$other_stories{$other}});
 330
 331         my $attr_title = blosxom::blosxom_html_escape("$shared_tags_number $shared_tags_text: $shared_tags_list");
 332         my $attr_href = blosxom::blosxom_html_escape($opath);
 333         my $html_title = blosxom::blosxom_html_escape($title);
 334         $related_stories .= qq($related_story_prefix<a href="$attr_href" class="$related_story_class" title="$attr_title">$html_title</a>);
 335
 336         $related_stories .= ' ('
 337             if $show_shared_tags || $show_number_of_shared_tags;
 338         $related_stories .= "$shared_tags_number "
 339             if $show_number_of_shared_tags;
 340         $related_stories .= $shared_tags_text
 341             if $show_shared_tags || $show_number_of_shared_tags;
 342         $related_stories .= blosxom::blosxom_html_escape(": $shared_tags_list")
 343             if $show_shared_tags;
 344         $related_stories .= ')'
 345             if $show_shared_tags || $show_number_of_shared_tags;
 346
 347         #use Data::Dumper;
 348         #$related_stories .= qw|$other: |.Dumper($other_stories{$other});
 349
 350         $related_stories .= $related_story_suffix;
 351     }
 352     $related_stories = "$related_stories_prefix$related_stories$related_stories_suffix" if $related_stories;
 353
 354
 355     return 1;
 356 }
 357
 358 sub filter {
 359     my ($pkg, $files_ref) = @_;
 360     my $filter_tags = CGI::param('-tags');
 361     my $filter_conj = CGI::param('-conj');
 362     $filter_tags =~ s/</[/gs; # No XSS here
 363     $filter_tags =~ s/>/]/gs; # No XSS here
 364     my @filter_tags = split(/\s*,\s*/, $filter_tags);
 365
 366     foreach my $key (keys %$files_ref) {
 367         next if -l $key;
 368         open(FILE, $key) or do { warn "Can't open $key: $!"; next; };
 369         my $tags_found = 0;
 370         my $empty_line_found = 0;
 371         while ($_ = <FILE>) {
 372             last if /^\s*$/;
 373             if (m!^$tag_re(.+?)$!) {
 374                 my @localtags = split($split_re, $1);
 375                 foreach my $tag (@localtags) {
 376                     if (ref $tags{$tag}) {
 377                         push(@{$tags{$tag}}, $key);
 378                     } else {
 379                         $tags{$tag} = [$key];
 380                     }
 381
 382                     # Related tags
 383                     next unless ($filter_tags and
 384                                  grep { $_ eq $tag } @filter_tags);
 385
 386                     foreach my $rtag (@localtags) {
 387                         next if ($rtag eq $tag);
 388
 389                         if ($related_tags{$rtag}) {
 390                             $related_tags{$rtag}++;
 391                         } else {
 392                             $related_tags{$rtag} = 1;
 393                         }
 394                     }
 395                 }
 396             }
 397         }
 398     }
 399
 400     my $max = 1;
 401     my $min = 0;
 402     foreach my $tag (keys %tags) {
 403         next if grep { $_ eq $tag } @tag_cloud_blacklist;
 404
 405         my $list = $tags{$tag};
 406         my $no = scalar @$list;
 407         next if $no < $min_tag_no;
 408         $max = $no if $max < $no;
 409         $min = $no if $min > $no || !$min;
 410     }
 411
 412     my $diff = $max - $min;
 413
 414     foreach my $tag (sort { lc($a) cmp lc($b) } keys %tags) {
 415         next if grep { $_ eq $tag } @tag_cloud_blacklist;
 416
 417         (my $url_tag = $tag) =~ s/\&/\%26/g;
 418         (my $html_tag = $tag) =~ s/\&/\&amp;/g;
 419         my $tag_no = scalar @{$tags{$tag}};
 420         next if $tag_no < $min_tag_no;
 421         my $tag_no_display = $show_tag_no ? " ($tag_no)" : '';
 422         my $title = $tag_no == 1 ? "1 posting tagged" : "$tag_no postings tagged";
 423         my $tag_percent = $diff ? int($min_size+((($max_size-$min_size)/$diff)*($tag_no-$min+1))) : 100;
 424         my $color = $diff ? &color_calc($tag_no, $min, $max) : '';
 425         my $style = '';
 426         $style .= qq!font-size: $tag_percent%;! if $show_tag_no_by_size && $diff;
 427         $style .= qq!color: #$color;! if $show_tag_no_by_color && $diff;
 428
 429         $global_tag_list .= make_tag_link($link_cloud, $tag, (title => $title, style => $style)).
 430                             qq|$tag_no_display,\n|;
 431     }
 432
 433     $global_tag_list =~ s/,$//;
 434     $global_tag_list = "$global_tag_prefix$global_tag_list$global_tag_suffix"
 435         if $global_tag_list;
 436
 437     return 1 unless $filter_tags;
 438
 439     my @tags = split($split_re, $filter_tags);
 440     my %localfiles = ();
 441     foreach my $tag (@tags) {
 442         my $files = $tags{$tag};
 443         next unless ref $files;
 444       FILES:
 445         foreach my $file (@$files) {
 446             # If all tags should match
 447             if ($filter_conj eq 'and') {
 448                 foreach my $ctag (@tags) {
 449                     if (!grep { $_ eq $file } @{$tags{$ctag}}) {
 450                         next FILES;
 451                     }
 452                 }
 453             }
 454
 455             $localfiles{$file} = $files_ref->{$file};
 456         }
 457     }
 458
 459     %$files_ref = %localfiles;
 460
 461     $current_filter_short = blosxom::blosxom_html_escape(
 462                               join($filter_conj eq 'and' ? ' + ' : ' | ',
 463                                    sort { lc($a) cmp lc($b) } @tags
 464                             ));
 465
 466     my $l_filter_tags = &url_escape($filter_tags);
 467     $conj = ($filter_conj eq 'and' ?
 468              qq! <em><a href="$base_url{blosxom}$l_filter_tags">and</a></em> ! :
 469              qq! <em><a href="$base_url{blosxom}$l_filter_tags&amp;-conj=and">or</a></em> !);
 470     $current_filter = ($current_filter_prefix.
 471                        join($conj,
 472                             map { make_tag_link('blosxom', $_); }
 473                             sort { lc($a) cmp lc($b) }
 474                             @tags).
 475                        $current_filter_suffix);
 476
 477     # Related tags
 478     if ($max_related_tags) {
 479         $related_tags = '';
 480         my $i = 1;
 481         foreach my $rtag (sort { $related_tags{$b} <=> $related_tags{$a} or
 482                                  $a cmp $b }
 483                           keys %related_tags) {
 484             next if ((grep { $_ eq $rtag } @related_tags_tag_blacklist) or
 485                      $related_tags{$rtag} < $min_tag_relations);
 486             my $rel_no = $show_tag_shares ? " ($related_tags{$rtag})" : '';
 487             $related_tags .= make_tag_link($link_rtag, $rtag, (rel => "tag", class => $related_tag_class, title => "Coincided $related_tags{$rtag} times")).
 488                              "$rel_no$related_tag_join";
 489             last if $i++ >= $max_related_tags;
 490         }
 491         $related_tags =~ s/\Q$related_tag_join\E$//;
 492
 493         #use Data::Dumper;
 494         $related_tags =
 495             "$related_tags_prefix$related_tags$related_tags_suffix"
 496                 if $related_tags;
 497         #.'<pre>'.Dumper(\%related_tags).'</pre>';
 498     }
 499
 500 #    use Data::Dumper;
 501 #    $debug = Dumper $filter_tags, $files_ref, \@tags, \%localfiles, \%tags;
 502
 503     1;
 504 }
 505
 506 # Create the url for a given tag. Depending on the tag and link type given,
 507 # this adds to, removes or replaces the current tag list. The link type given
 508 # is one of the keys of %base_url
 509 sub make_tag_link {
 510     my ($link, $tag, %attrs) = @_;
 511     my $filter_tags = CGI::param('-tags');
 512     my $conj = (CGI::param('-conj') eq 'and' ? '&-conj=and' : '');
 513     # If we're linking to ourselves, the currently selected tag list is not
 514     # empty, and this tag is not in there yet, prefix the link with the
 515     # current filter list.
 516     my $tags;
 517     if (($link_cloud eq 'blosxom') and $filter_tags) {
 518         if ($filter_tags =~ /(^|,)\Q$tag\E($|,)/) {
 519             # The tag is already in there, remove it
 520             $tags = $filter_tags;
 521             $tags =~ s/\Q,$tag,\E/,/ || $tags =~ s/(^|,)\Q$tag\E($|,)//;
 522         } else {
 523             # The tag is not in there, add it
 524             $tags = "$filter_tags,$tag";
 525         }
 526         $tags = &url_escape($tags);
 527         $tags .= $conj;
 528     } else {
 529         # We're linking externally, or don't have a filter yet. Just use the
 530         # selected tag as the filter
 531         $tags = &url_escape($tag);
 532     }
 533
 534     # Set the href attribute
 535     $attrs{href} = "$base_url{$link}$tags";
 536
 537     # Generate attribute values
 538     my $attrs = join('',
 539                 map { $val = blosxom::blosxom_html_escape($attrs{$_});
 540                       qq! $_="$val"!;
 541                 } keys %attrs);
 542
 543     return "<a$attrs>" . blosxom::blosxom_html_escape($tag) . "</a>";
 544 }
 545
 546
 547 sub color_calc {
 548     my ($tag_no, $min, $max) = @_;
 549     my $diff = $max - $min;
 550
 551     my $result = [];
 552
 553     foreach my $i (0..2) {
 554         my $s = &get_dec($start_color, $i*2);
 555         my $e = &get_dec($end_color, $i*2);
 556         my $diff_se = abs($s-$e);
 557
 558         my $rogob = ($diff_se/$diff)*($tag_no-$min);
 559         $rogob = int($s < $e ? $s + $rogob : $s - $rogob);
 560         $result->[$i] = sprintf('%02x', $rogob);
 561     }
 562
 563     #use Data::Dumper;
 564     return join('', @$result);
 565 }
 566
 567 sub get_dec {
 568     my ($color, $offset) = @_;
 569     return hex(substr($color, $offset, 2));
 570 }
 571
 572 sub url_escape {
 573     my $s = shift;
 574     $s =~ s/[^0-9A-Za-z,.:]/sprintf('%%%02X', ord($&))/seg;
 575     return $s;
 576 }
 577
 578 1;