X-Git-Url: https://git.decadent.org.uk/gitweb/?p=memories.git;a=blobdiff_plain;f=Tagtools.pm;fp=Tagtools.pm;h=44c5405ef50a770785eed8b50495fa8fd7eb384e;hp=0fc2529b370505206b4bc99f3aed29aae1c49b09;hb=c4b2f2843ca943f5235a1abb001523bffb7205c4;hpb=6c828edcb380b80c77f01caecd306337a954de36

diff --git a/Tagtools.pm b/Tagtools.pm
index 0fc2529..44c5405 100644
--- a/Tagtools.pm
+++ b/Tagtools.pm
@@ -1,9 +1,14 @@
 package Tagtools;
+use warnings;
+use Lingua::EN::Inflect::Number qw(to_PL);
+use URI::Escape;
 use HTML::TagCloud;
 use Carp;
 use Cache::FileCache;
 use Storable qw(freeze); use MIME::Base64;
 use Calendar::Simple;
+use Text::Balanced qw(extract_multiple extract_quotelike);
+
 sub import {
     my $whence = caller;
     my ($class) = @_;
@@ -16,9 +21,9 @@ sub import {
     *{$whence."::do_cached"} = sub {
         my ($self, $codeblock,$arg) = @_;
         my $key = 0+$codeblock; if ($arg) { $key .=":".encode_base64(freeze(\$arg));  }
-        my $c = $cache->get(0+$codeblock); return @$c if $c;
+        my $c = $cache->get($key); return @$c if $c;
         my @stuff = $codeblock->($arg);
-        $cache->set(0+$codeblock, [ @stuff ]);
+        $cache->set($key, [ @stuff ]);
         return @stuff;
     };
     *{$whence."::_tagcloud"} = sub {
@@ -31,8 +36,8 @@ sub import {
         $cloud
     };
     *{$whence."::_calendar"} = sub {
-        my $self = shift;
         my $arg = shift;
+        require Time::Piece;
         my ($y, $m) = split /-/, ($arg || Time::Piece->new->ymd);
         my @m = Calendar::Simple::calendar($m, $y);
         my @month;
@@ -52,11 +57,65 @@ sub import {
         return \@month;
     };
     for my $thing (qw(tagcloud calendar)) {
-        *{$whence."::$thing"} = sub { shift->do_cached($thing, @_) }
+        *{$whence."::$thing"} = sub { shift->do_cached(\&{$whence."::_".$thing}, @_) }
     }
+    *{$whence."::setup_tagging"} = \&Tagtools::_setup_tagging;
+}
+
+sub _setup_tagging {
+    my ($maypole_class, $target_table, $tag_table_name) = @_;
+    my $class_for = sub {
+        $maypole_class->config->model->class_of($maypole_class, shift)
+    };
+    $tag_table_name ||= "tag";
+    my $target = $class_for->($target_table) 
+        || die "Couldn't find a class representing $target_table";
+    my $via_table = $tag_table_name . "ging";
 
+    # Does the tag table exist?
+    # If not create it or at least moan
+    # If so configure it as a new class
+
+    # At this point, the $via_table should now be able to be named as...
+    my $tag_class = $class_for->($tag_table_name);
+    my $via = $tag_class."ging";
+
+    # Set up the class
+    @{$via."::ISA"} = @{$tag_class."::ISA"};
+    $via->table($via_table);
+    $via->columns(TEMP => qw/count/);
+    $via->columns(Essential => "id", $tag_table_name, $target_table);
+    # Set up the auxilliary methods
+    $via->set_sql(summary => qq/
+    SELECT  id, $tag_table_name, count(*) AS count
+    FROM $via_table
+    GROUP BY $tag_table_name
+    ORDER BY count DESC
+    LIMIT 50
+    /);
+    $via->set_sql(all => qq/
+    SELECT  id, $tag_table_name, count(*) AS count
+    FROM $via_table
+    GROUP BY $tag_table_name
+    ORDER BY count DESC
+        /);
+    # Set up the has_many relations
+    $via->has_a($target_table => $target);
+    $via->has_a($tag_table_name => $tag_class);
+    $target->has_many(to_PL($tag_table_name) => [ $via => $tag_table_name ]);
+    $target->has_many(to_PL($via) => $via);
+    $tag_class->has_many(to_PL($target_table) => [ $via => $target_table ]);
+    $tag_class->has_many(to_PL($via_table) => $via);
 }
 
+sub separate_tags {
+    map { s/^"|"$//g; $_} 
+    extract_multiple(
+        lc $_[1], [ 
+            \&extract_quotelike, 
+            qr/([^\s,]+)/ 
+        ], undef,1)
+}
 
 # THIS IS A HACK