From: Chris W. <la...@us...> - 2005-03-29 05:10:46
|
Update of /cvsroot/openinteract/OpenInteract2/pkg/object_tags/OpenInteract2 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30046/object_tags/OpenInteract2 Added Files: ObjectTag.pm ObjectTagWatcher.pm TaggableObject.pm Log Message: OIN-37: migrate delicious_tags package to core --- NEW FILE: ObjectTag.pm --- package OpenInteract2::ObjectTag; # $Id: ObjectTag.pm,v 1.1 2005/03/29 05:10:37 lachoy Exp $ use strict; use DateTime; use Log::Log4perl qw( get_logger ); use OpenInteract2::Constants qw( :log ); @OpenInteract2::ObjectTag::ISA = qw( OpenInteract2::ObjectTagPersist ); my ( $log ); # TODO: this should be wrapped in a transaction... sub add_tags { my ( $class, $object_type, $object_id, $url, $name, @tags ) = @_; # first delete all tags for this type and ID... $class->db_delete({ table => $class->table_name, where => 'object_type = ? AND object_id = ?', value => [ $object_type, $object_id ], }); # ..then add all the given tags so there's no overlap foreach my $tag ( @tags ) { $class->new({ tag => $tag, object_type => $object_type, object_id => $object_id, url => $url, name => $name, created_on => DateTime->now(), })->save(); } } sub fetch_all_tags { my ( $class ) = @_; my $tags = $class->db_select({ select_modifier => 'DISTINCT', select => [ 'tag' ], from => [ $class->table_name ], order => 'tag', return => 'single-list', }); return $tags; } sub fetch_all_tags_with_count { my ( $class, $hash_option ) = @_; my $counts = $class->db_select({ select => [ 'tag', 'count(*)' ], from => [ $class->table_name ], order => 'tag', group => 'tag', }); return $class->_translate_tag_and_count( $counts, $hash_option ); } sub fetch_tags_for_object { my ( $class, $object_type, $object_id ) = @_; my $tags = $class->db_select({ select => [ 'tag' ], from => [ $class->table_name ], where => 'object_type = ? AND object_id = ?', value => [ $object_type, $object_id ], order => 'tag', return => 'single-list', }); return $tags; } sub fetch_tags_with_count_for_object { my ( $class, $object_type, $object_id, $hash_option ) = @_; $log ||= get_logger( LOG_APP ); my $tags = $class->fetch_tags_for_object( $object_type, $object_id ) || []; $log->is_info && $log->info( "For [$object_type: $object_id] got ", "tags: ", join( ', ', @{ $tags } ) ); return ( scalar @{ $tags } ) ? $class->_fetch_counts_for_tags( $tags, $hash_option ) : []; } # Return all objects that have a given tag in \@tags; we uniq-ify them # first so there's only one instance of each in the returned arrayref sub fetch_tag_objects { my ( $class, $tags, $skip_type, $skip_id ) = @_; $log ||= get_logger( LOG_APP ); my ( $where, $tag_values ) = $class->_create_or_clause_for_tags( $tags ); $log->is_debug && $log->debug( "Finding objects tagged with: ", join( ', ', @{ $tag_values } ) ); my @values = @{ $tag_values }; if ( $skip_type and $skip_id ) { $where .= ' AND ( object_type != ? AND object_id != ? )'; push @values, $skip_type, $skip_id; } elsif ( $skip_type ) { $where .= ' AND $object_type != ? '; push @values, $skip_type; } my $tag_objects = $class->fetch_group({ where => $where, value => \@values, order => 'object_type', }); $log->is_debug && $log->debug( "Found ", scalar @{ $tag_objects }, " items; now ", "finding unique objects..." ); my @uniq_tag_objects = (); my %seen = (); foreach my $tag_object ( @{ $tag_objects } ) { my ( $type, $id ) = ( $tag_object->{object_type}, $tag_object->{object_id} ); next if ( $seen{ $type }->{ $id } ); $seen{ $type }->{ $id }++; push @uniq_tag_objects, $tag_object; } $log->is_debug && $log->debug( "Found ", scalar @uniq_tag_objects, " unique items" ); return \@uniq_tag_objects; } sub fetch_count { my ( $class, $tag ) = @_; my $count = $class->db_select({ select => [ 'count(*)' ], from => [ $class->table_name ], where => 'tag = ?', value => [ $tag ], return => 'single-list', }); return $count->[0]; } sub fetch_related_tags { my ( $class, @base_tags ) = @_; my $table = $class->table_name; my ( $base_where, $tag_values ) = $class->_create_or_clause_for_tags( \@base_tags ); my $sql = qq{ SELECT d2.tag FROM $table d1, $table d2 WHERE ( $base_where ) AND d2.object_type = d1.object_type AND d2.object_id = d1.object_id AND d2.tag != d1.tag }; my $tags = $class->db_select({ sql => $sql, value => $tag_values, return => 'single-list', }); return $tags; } sub fetch_related_tags_with_count { my ( $class, @tags_and_option ) = @_; my $hash_option = ( ref $tags_and_option[-1] eq 'HASH' ) ? pop @tags_and_option : undef; my $tags = $class->fetch_related_tags( @tags_and_option ); return $class->_fetch_counts_for_tags( $tags, $hash_option ); } sub _fetch_counts_for_tags { my ( $class, $tags, $hash_option ) = @_; my ( $where, $tag_values ) = $class->_create_or_clause_for_tags( $tags ); my $counts = $class->db_select({ select => [ 'tag', 'count(*)' ], from => [ $class->table_name ], where => $where, value => $tag_values, group => 'tag', }); return $class->_translate_tag_and_count( $counts, $hash_option ); } sub _translate_tag_and_count { my ( $class, $counts, $hash_option ) = @_; if ( ref $hash_option eq 'HASH' ) { my @records = (); foreach my $rec ( @{ $counts } ) { push @records, { tag => $rec->[0], count => $rec->[1] }; } return \@records; } else { return $counts; } } # $tags can be simple scalar, arrayref of simple scalars, or # potentially an arrayref of arrayrefs sub _create_or_clause_for_tags { my ( $class, $tags ) = @_; # flatten out $tags into a simple list my @all_tags = (); my @use_tags = ( ref $tags ) ? @{ $tags } : $tags; foreach my $use_tag ( @use_tags ) { push @all_tags, ref( $use_tag ) ? @{ $use_tag } : split /\s+/, $use_tag; } my $clause = '(' . join( ' OR ', map { 'tag = ?' } grep { $_ } @all_tags ) . ')'; $log ||= get_logger( LOG_APP ); $log->is_info && $log->info( "Created WHERE clause '$clause' for ", "tags: ",join( ', ', @all_tags ) ); return ( $clause, \@all_tags ); } 1; __END__ =head1 NAME OpenInteract2::ObjectTag - SPOPS class for lightweight object tags =head1 SYNOPSIS my $tag_class = CTX->lookup_object( 'object_tag' ); my $tags = $tag_class->fetch_all_tags; print "Current tags: ", join( ", ", @{ $tags } ); my $tags_and_count = $tag_class->fetch_all_tags_and_count; print "Current tags:\n"; foreach my $tag_and_count( @{ $tags_with_count } ) { print " - $tag_and_count->[0]: $tag_and_count->[1]\n"; } # ...same but each tag + count returned as hashref my $tags_and_count = $tag_class->fetch_all_tags_and_count( {} ); print "Current tags:\n"; foreach my $tag_and_count( @{ $tags_with_count } ) { print " - $tag_and_count->{tag}: $tag_and_count->{count}\n"; } my $news_id = $news->id; my $tags = $tag_class->fetch_tags_for_object( 'News', $news_id); print "Tags for news ID $news_id: ", join( ", ", @{ $tags } ); my $tags_and_count = $tag_class->fetch_tags_with_count_for_object( 'News', $news_id ); print "Tags with count for news ID $news_id:\n"; foreach my $tag_and_count( @{ $tags_with_count } ) { print " - $tag_and_count->[0]: $tag_and_count->[1]\n"; } # ...same but each tag + count as hashref my $tags_and_count = $tag_class->fetch_tags_with_count_for_object( 'News', $news_id, {} ); print "Tags with count for news ID $news_id:\n"; foreach my $tag_and_count( @{ $tags_with_count } ) { print " - $tag_and_count->{tag}: $tag_and_count->{count}\n"; } # Fetch a count by tag my $count = $tag_class->fetch_count( 'sometag' ); print "Number of objects with tag 'sometag': $count\n"; # Find related tags -- this will find all other tags attached to # objects attached to this tag my $tags = $tag_class->fetch_related_tags( 'sometag' ); print "Other tags related to 'sometag': ", join( ', ', @{ $tags } ); # Similarly, find tag and count for related tags print "Also related to 'sometag':\n"; my $tags = $tag_class->fetch_related_tags_with_count( 'sometag' ); foreach my $tag_and_count( @{ $tags_with_count } ) { print " - $tag_and_count->{tag}: $tag_and_count->{count}\n"; } # Find all the OpenInteract2::ObjectTag objects tagged with # 'linux' my $items = $tag_class->fetch_tag_objects( 'linux' ); # Find all the OpenInteract2::ObjectTag objects tagged with # 'linux' or 'win32' my $items = $tag_class->fetch_tag_objects( [ 'linux', 'win32' ] ); # Find all the OpenInteract2::ObjectTag objects tagged with # 'linux' or 'win32' that aren't of the 'blog' type my $items = $tag_class->fetch_tag_objects( [ 'linux', 'win32' ], 'blog' ); # Find all the OpenInteract2::ObjectTag objects tagged with # 'linux' or 'win32' that aren't of the 'blog' type with ID '35' my $items = $tag_class->fetch_tag_objects( [ 'linux', 'win32' ], 'blog', '35' ); # Display the OpenInteract2::ObjectTag objects foreach my $item ( @{ $items } ) { my $full_url = OpenInteract2::URL->create( $item->{url} ); print "Item type: $item->{object_type} with ID $item->{object_id}\n", " Name: $item->{name}\n", " URL: $full_url\n"; } =head1 DESCRIPTION This is the SPOPS class for storing and retrieving tags. It has a number of useful class methods to get interesting data out of the system. =head1 CLASS METHODS B<add_tags( $object_type, $object_id, $url, $name, @tags )> Adds a tag record with C<$object_type>, C<$object_id>, C<$url> (which will not be modified), C<$name> for each of C<@tags>. B<fetch_all_tags()> Returns: arrayref of strings, one for each distinct tag in system B<fetch_all_tags_with_count( [ \%hash_option ] )> Returns: an arrayref of records indicating a tag and the number of objects tagged by it; if C<\%hash_option> given each record is an arrayref with the keys 'tag' and 'count'; if it's not given each record is an arrayref with element 0 as the tag and element 1 as the count. B<fetch_tags_for_object( $object_type, $object_id )> Returns: arrayref of strings, one of each distinct tag used by the object with type C<$object_type> and ID C<$object_id>. B<fetch_tags_with_count_for_object( $object_type, $object_id, [ \%hash_option ] )> Returns: arrayref of records, one of each distinct tag used by the object with type C<$object_type> and ID C<$object_id>; if C<\%hash_option> given each record is an arrayref with the keys 'tag' and 'count'; if it's not given each record is an arrayref with element 0 as the tag and element 1 as the count. B<fetch_tag_objects( $tags | \@tags, [ $skip_object_type, $skip_object_id ] )> Find out what objects have any of a given set of tags. If an object has multiple of the given tags it's only returned once. If given C<$tags> as a simple scalar we C<split()> on C<\s+> before submitting. If given C<$skip_object_type> we don't return objects with this 'object_type' property. If also given C<$skip_object_id> we don't return objects with this 'object_type' property and with this 'object_id' property. Returns: arrayref of distinct L<OpenInteract2::ObjectTag> objects matching the given criteria. B<fetch_count( $tag )> Returns: number of objects with the given tag. B<fetch_related_tags( @tags )> Returns: arrayref of strings, one for each distinct tag used by objects tagged by one of C<@tags> but not in C<@tags>. B<fetch_related_tags_with_count( @tags, \%hash_option )> Returns: arrayref of records, one for each distinct tag used by objects tagged by one of C<@tags> but not in C<@tags>; if C<\%hash_option> given each record is an arrayref with the keys 'tag' and 'count'; if it's not given each record is an arrayref with element 0 as the tag and element 1 as the count. =head1 OBJECT METHODS None in this class; see L<SPOPS::DBI> for basic object persistence. =head1 SEE ALSO L<OpenInteract2::TaggableObject>: To call some of these methods in relation to another object. L<OpenInteract2::Observer::AddObjectTags>: Which adds tags based on object adds/updates. =head1 COPYRIGHT Copyright (c) 2004-2005 Chris Winters. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS Chris Winters E<lt>ch...@cw...E<gt> --- NEW FILE: ObjectTagWatcher.pm --- package OpenInteract2::ObjectTagWatcher; # $Id: ObjectTagWatcher.pm,v 1.1 2005/03/29 05:10:37 lachoy Exp $ use strict; $OpenInteract2::ObjectTagWatcher::VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/); sub update { my ( $class, $type, $config ) = @_; return unless ( $type eq 'spops' and ref $config eq 'HASH' ); if ( $config->{is_taggable} eq 'yes' ) { $config->{isa} ||= []; push @{ $config->{isa} }, 'OpenInteract2::TaggableObject'; } } 1; __END__ =head1 NAME OpenInteract2::ObjectTagWatcher - Configuration watcher to look for 'is_taggable' =head1 SYNOPSIS [myspops] class = OpenInteract2::Foo ... is_taggable = yes # At startup OpenInteract2::Foo will have # OpenInteract2::TaggableObject in its 'isa' =head1 DESCRIPTION Configuration initializer to add a shortcut to SPOPS configuration -- a 'is_taggable = yes' will result in the SPOPS class getting L<OpenInteract2::TaggableObject> in its 'isa'. =head1 SEE ALSO L<OpenInteract2::Config::Initializer> =head1 COPYRIGHT Copyright (c) 2004-2005 Chris Winters. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS Chris Winters E<lt>ch...@cw...E<gt> --- NEW FILE: TaggableObject.pm --- package OpenInteract2::TaggableObject; # $Id: TaggableObject.pm,v 1.1 2005/03/29 05:10:37 lachoy Exp $ use strict; use OpenInteract2::URL; use Scalar::Util qw( blessed ); sub add_tags { my ( $item, @data ) = @_; require OpenInteract2::ObjectTag; my ( $object_type, $object_id, $url, $name, @tags ); # call from object: tags are in @data if ( blessed $item ) { my $info = $item->object_description; ( $object_type, $object_id, $url, $name, @tags ) = ( $info->{name}, $info->{object_id}, $info->{url}, $info->{title}, @data ); } else { ( $object_type, $object_id, $url, $name, @tags ) = @data; } # We want to remove any deployment descriptor from the front -- # URLs are stored non-contextualized so things won't get hinky if # you need to relocate $url = OpenInteract2::URL->strip_deployment_context( $url ); return OpenInteract2::ObjectTag->add_tags( $object_type, $object_id, $url, $name, @tags ); } sub fetch_my_tags { my ( $item, @data ) = @_; require OpenInteract2::ObjectTag; my ( $object_type, $object_id ); if ( blessed $item ) { $object_type = $item->CONFIG->{object_name}; $object_id = $item->id; } else { ( $object_type, $object_id ) = @data; } return OpenInteract2::ObjectTag ->fetch_tags_for_object( $object_type, $object_id ); } sub fetch_my_tags_with_count { my ( $item, @data ) = @_; require OpenInteract2::ObjectTag; my ( $object_type, $object_id ); if ( blessed $item ) { $object_type = $item->CONFIG->{object_name}; $object_id = $item->id; } else { ( $object_type, $object_id ) = @data; } return OpenInteract2::ObjectTag ->fetch_tags_with_count_for_object( $object_type, $object_id ); } sub fetch_my_related_object_info { my ( $item, @data ) = @_; require OpenInteract2::ObjectTag; my ( $object_type, $object_id, @tags ); if ( blessed $item ) { $object_type = $item->CONFIG->{object_name}; $object_id = $item->id; @tags = @data; } else { ( $object_type, $object_id, @tags ) = @data; } my $related_tags = OpenInteract2::ObjectTag->fetch_related_tags( $object_type, $object_id, @tags ); return OpenInteract2::ObjectTag ->fetch_tag_objects( $related_tags, $object_type, $object_id ); } 1; |