# Copyright 2002-2008 Josh Clark and Global Moxie, LLC. This code cannot be
# redistributed without permission from globalmoxie.com.  For more
# information, consult your Big Medium license.
#
# $Id: Tag.pm 3233 2008-08-21 12:47:26Z josh $

package BigMed::Tag;
use strict;
use warnings;
use utf8;
use Carp;
$Carp::Verbose = 1;

use BigMed::Error;
use base qw(BigMed::MiniContent);
use BigMed::Pointer;
use BigMed::DiskUtil qw(bm_file_path bm_delete_dir);

###########################################################
# SET PULLQUOTE DATA SCHEMA
###########################################################

my @data_schema = (
    {   name   => 'name',
        type   => 'simple_text',
        index  => 1,
        unique => 1,
    },
    {   name   => 'slug',
        type   => 'url_safe',
        index  => 1,
        unique => 1,
    },
);
BigMed::Tag->register_minicontent( elements => \@data_schema, );

###########################################################
# CALLBACKS
###########################################################

BigMed::Tag->add_callback( 'before_save', \&_before_tag_save );
BigMed::Tag->add_callback( 'before_trash', \&_before_trash );
BigMed::Tag->add_callback( 'before_trash_all', \&_before_trash_all );

sub _before_tag_save {
    my $self = shift;
    my $name = $self->name;
    $name = q{} if !defined $name;
    $name =~ s/\A\s+//ms;
    $name =~ s/\s+\z//ms;
    $name =~ s/\s+/ /msg;
    if ( $name eq q{} ) {
        return BigMed::Error->set_error(
            head => 'TAG_Tags must have at least one non-space char',
            text => 'TAG_TEXT_Tags must have at least one non-space char',
        );
    }
    $self->set_name($name);
    return if !defined $self->generate_tag_slug(); #guarantee unique slug
    return 1;
}

sub _before_trash {
    my $self = shift;
    return _remove_pointers_tagdir([$self]);
}

sub _before_trash_all {
    my $select = shift;
    return _remove_pointers_tagdir([ $select->fetch ]);
}

sub _remove_pointers_tagdir {
    my $rtags = shift;
    my @id;
    my ( $sid, $tag_dir );
    foreach my $tag ( @{$rtags} ) {
        push @id, $tag->id;
        $sid ||= $tag->site;
        croak 'trash_all expects all tags to be from same site'
          if $sid != $tag->site;
        if ( !$tag_dir ) {
            defined( my $site = BigMed::Site->fetch($sid) ) or return;
            return 1 if !$site;
            my $dot = BigMed->bigmed->env('DOT');
            $tag_dir = bm_file_path( $site->homepage_dir, "bm${dot}tags" );
        }
        bm_delete_dir( bm_file_path( $tag_dir, $tag->slug ) ) or return;
    }
    return 1;
}

###########################################################
# UTILITIES
###########################################################

sub generate_tag_slug {
    my $self = shift;
    if ( !defined $self->slug || $self->slug eq q{} ) {
        my $slug = defined $self->name ? ( lc $self->name ) : q{};
        $slug =~ s/&(#?[xX]?([0-9a-fA-F]+|\w+);)//g; #strip entities
        $slug =~ s/[^0-9a-z\- _]//msg;
        $slug =~ s/\s+/-/msg;
        $slug = substr( $slug, 0, 50 ) if length($slug) > 50;
        if ( $slug !~ /[0-9a-zA-Z]/ms ) {
            $self->update_id or return;
            $slug = 'tag' . $self->id;
        }
        $self->set_slug($slug);
    }
    while ( my $not_unique = !$self->is_unique('slug') ) {
        return if !defined $not_unique;    #i/o error from driver
        my $slug = $self->slug;
        if ( $slug =~ /\-(\d+)$/ms ) {
            my $suffix = $1;
            $suffix++;
            $slug =~ s/\-\d+$/\-$suffix/ms;
        }
        else {
            $slug .= '-2';
        }
        $self->set_slug($slug);
    }
    return $self->slug;
}

sub all_tags {
    my $self = shift;
    my $site = shift or croak 'all_tags requires site id or object';
    my $sid  = ref $site ? $site->id : $site;
    croak 'all_tags requires site object with id' if !$sid;

    my $all = BigMed::Tag->select( { site => $sid },
        { sort => 'name', order => 'ascend' } )
      or return;
    my @names;
    while ( my $rindex = $all->next_index ) {
        push @names, $rindex->{name};
    }
    return @names;
}

sub set_page_tags {
    my ( $self, $page, $rtags ) = @_;
    croak 'set_page_tags requires page object'
      if !$page || !$page->isa('BigMed::Content::Page');
    my $sid        = $page->site;
    my @old_rpairs = $page->load_related_objects('tag');

    my @names = $rtags ? ( grep { defined $_ && $_ ne q{} } @{$rtags} ) : ();
    if ( !@names ) {  #no tags, remove any existing tag pointers for this page
        my $pointers = BigMed::Pointer->select(
            {   site         => $sid,
                source_table => $page->data_source,
                source_id    => $page->id,
                target_table => $self->data_source,
            }
          )
          or return;
        $pointers->trash_all or return;
        BigMed::Pointer->reset_obj_cache($page);
        $page->set_stash( '_CONTENT::RELATEDOBJ_tag', undef );
        $self->cleanup_orphans( [map { $_->[1] } @old_rpairs] )
          if @old_rpairs;
        return 1;
    }

    #fetch existing tags for new tag set
    my %exists;
    my $existing = BigMed::Tag->select( { site => $sid, name => \@names } )
      or return;
    my $tag;
    while ( $tag = $existing->next ) {
        $exists{ lc $tag->name } = $tag;
    }
    return if !defined $tag;    #i/o error

    #create new tags if necessary
    foreach my $name (@names) {
        next if $exists{ lc $name };
        my $newtag = BigMed::Tag->new();
        $newtag->set_site($sid);
        $newtag->set_name($name);
        $newtag->save or return;
        $exists{ lc $name } = $newtag;
    }

    #remove old tag associations and winnow new_set to items that
    #need to be tied to this page
    my %new_set = map { ( lc $_ ) => $_ } @names;
    my @check_orphan;
    foreach my $rpair (@old_rpairs) {
        my $name = lc $rpair->[1]->name;
        if ( !$new_set{$name} ) {
            BigMed::Pointer->reset_obj_cache($page);
            $page->set_stash( '_CONTENT::RELATEDOBJ_tag', undef );
            $rpair->[0]->trash or return;
            push @check_orphan, $rpair->[1];
        }
        delete $new_set{$name};
    }

    #add any new associations
    foreach my $lc_name ( keys %new_set ) {
        $page->save_object_link(
            linked_obj => $exists{$lc_name},
            type       => 'tag',
          )
          or return;
    }

    $self->cleanup_orphans( \@check_orphan ) if @check_orphan;

    return 1;
}

sub cleanup_orphans {
    my ( $self, $rorphans ) = @_;
    croak 'cleanup_orphans requires tag object argument' if !$rorphans;
    $rorphans = [$rorphans] if ref $rorphans ne 'ARRAY';
    ( my @check_tags = @{$rorphans} ) or return 1;

    my $site_id  = $check_tags[0]->site;
    my $pointers = BigMed::Pointer->select(
        {   site         => $site_id,
            target_table => $self->data_source,
        }
      )
      or return;
    foreach my $tag_obj (@check_tags) {
        if ( $tag_obj->site != $site_id ) {
            croak 'cleanup_orphans requires objects to belong to same site';
        }
        my $find_this =
          $pointers->select( { site => $site_id, target_id => $tag_obj->id },
            { limit => 1 } )
          or return;
        if ( $find_this->count < 1 ) {    #orphan
            $tag_obj->trash or return;
        }
    }
    return 1;
}

sub tag_counts {
    my $self = shift;
    my ( $site, $point_cache, $page_cache ) = @_;
    if ( !ref $site ) {
        require BigMed::Site;
        $site = BigMed::Site->fetch($site);
        return                              if !defined $site;
        croak "No such site with id $site." if !$site;
    }
    my $sid = $site->id;
    $point_cache ||= 'BigMed::Pointer';
    $page_cache  ||= 'BigMed::Content::Page';

    #find active pages (published pages in active sections)
    my %active_page;
    {
        my @secs =
          ( $site->homepage_id, $site->all_active_descendants_ids() );
        my $active =
          $page_cache->select(
            { site => $sid, sections => \@secs, pub_status => 'published' } );
        while ( my $rindex = $active->next_index ) {
            $active_page{ $rindex->{id} } = 1;
        }
    }

    my %tag_count;
    my ( $low_id, $high_id );
    my $tag_pointers = $point_cache->select(
        {   site         => $sid,
            source_table => BigMed::Content::Page->data_source,
            target_table => BigMed::Tag->data_source,
            source_id    => [keys %active_page],
        }
      )
      or return;
    while ( my $rindex = $tag_pointers->next_index ) {
        my $id = $rindex->{target_id};
        $tag_count{$id} ||= 0;
        $tag_count{$id}++;
        $low_id = $id
          if !$low_id || $tag_count{$id} < $tag_count{$low_id};
        $high_id = $id
          if !$high_id || $tag_count{$id} > $tag_count{$high_id};
    }
    if (%tag_count) {
        return {
            count => \%tag_count,
            low   => $tag_count{$low_id},
            high  => $tag_count{$high_id},
        };
    }
    else {
        return { count => {}, low => 0, high => 0 };
    }
}

sub exists_at_site {
    my ( $self, $site ) = @_;
    return BigMed::Tag->fetch( { site => $site->id, name => $self->name },
        { limit => 1 } );
}

1;

__END__

=head1 NAME

BigMed::Tag - Big Medium tag object

=head1 DESCRIPTION

A BigMed::Tag object holds the name of a single tag for a site. Tags are
associated with individual content elements via BigMed::Pointer objects.

=head1 USAGE

BigMed::Tag is a subclass of BigMed::Data. In addition to the methods 
documented below, please see the BigMed::Data documentation for details about
topics including:

=over 4

=item Creating a new data object

=item Saving a data object

=item Finding and sorting saved data objects

=item Data access methods

=item Error handling

=back

=head1 METHODS

=head2 Data Access Methods

BigMed::Tag objects hold the following pieces of data. They can be
accessed and set using the standard data access methods described in the
BigMed::Data documentation. See the L<"Searching and Sorting"> section below
for details on the data columns available to search and sort BigMed::Site
objects.

=over 4

=item * id

The numeric ID of the tag object

=item * site

The numeric ID of the site to which the object belongs

=item * name

The unique name of the tag. When saved, all leading, trailing and consecutive
whitespace is stripped from the name value. An error is thrown if no
value is supplied.

=item * slug

The unique filesystem-safe, url-safe name for the tag. This is used, for example,
when providing a URL to the list of resources associated with the tag.

When the object is saved, a slug is automatically generated if one is not
provided (see C<generate_tag_slug>).

=item * mod_time

Timestamp for when the last time the object was saved.

=item * create_time

Timestamp for when the object was first created.

=back

=head3 Searching and Sorting

You can look up and sort records by any combination of the following fields.
See the C<fetch> and C<select> documentation in BigMed::Data for more info.

=over 4

=item * id

=item * mod_time

=item * site

=item * name

=item * slug

=back

=head2 Tag Methods

=head3 C<<BigMed::Tag->all_tags($site_obj_or_id)>>

Returns an array of all tag names for the site, alphabetically sorted.
(An empty array could indicate an I/O error.)

    my @tags = BigMed::Tag->all_tags($site_obj);
    BigMed::Error->error_stop() if !@tags && BigMed::Error->error;

=head3 C<<BigMed::Tag->set_page_tags($page_obj, \@tagnames>>

Sets the page's tag set to the tag names in the array reference.

The array reference should include all of the page's tags. If a page
already has tags, but any of those tags are not included in the array
reference, those tag associations will be removed (those removed tags will
also be run through the C<cleanup_orphans> method and the target
tag object will be trashed if no other pages are associated with it).

For each of the tag names, if a tag object with that name already exists
(not case-sensitive), then the page will be associated with that object.
Otherwise, a new tag object will be created.

Returns true on success, undef on error (and also adds a message to the
BigMed error queue).

To clear the page of all tags:

    BigMed::Tag->set_page_tags($page, []);
    BigMed::Tag->set_page_tags($page); #equivalent


=head3 C<<BigMed::Tag->tag_counts($site_obj_or_id[, $pointer_selection, $page_selection])>>

Returns a hash reference of info about the number of tag associations
on the site. If there's an error retrieving the data, the routine
returns undef instead (and sets a message in the BigMed error queue).

    my $rcount = BigMed::Tag->tag_counts( $site, $pointers, $pages )
      or BigMed->error_stop;

The first argument is a site object or id (some performance gains if
it's an object), and the optional
second and third arguments are selections of BigMed::Pointer objects
and BigMed::Content::Page objects to use for the
counts (if selections are not provided, the routine gathers a
fresh selection of all pointers that point to tag objects and
a fresh selection of active page objects from the entire site).

The returned hash reference has three key/value pairs:

=over 4

=item * count => \%count_hash

A hash reference where keys are IDs of tag objects and values are the
number of objects the tag is a associated with. (Tags with no associations
are not included in the hash.)

=item * low => $num

The lowest value in the count hash (i.e. the lowest number of tag associations
for any of the tags). If the count hash is empty, the value is 0.
=back

=item * high => $num

The highest value in the count hash (i.e. the largest number of tag associations
for any of the tags). If the count hash is empty, the value is 0.

=back

=head3 C<<$tag_obj->generate_tag_slug()>>

Ensures that the tag's slug value is populated by a unique value. If the slug
is empty or undefined, a filesystem-safe, url-safe value is generated based
on the tag's name value.

Returns true on success, false on failure (and also adds a message to the
BigMed error queue).

This method is called anytime that you save a slug, so you can generally
get away with leaving the slug name undefined, and saving the object
will generate the required slug. However, if you're changing a tag's name,
it's good practice to set the slug to undef and re-run the
C<generate_slug_method> to give it a new slug based on the new name:

    $tag->set_name('new_name');
    $tag->set_slug(undef);
    $tag->generate_tag_slug() or BigMed::Error->error_stop;

=head3 C<<BigMed::Tag->cleanup_orphans( $tag_obj || \@tag_objs) )>>

Checks the tag object in the argument (or in the array if the argument
is an array reference) to see if it's used in any pages. If not, the
object is deleted.

Returns true on success, false on failure (and adds a message to the
BigMed error queue).

NOTE: The tag objects should all be from the same site.

=head1 SEE ALSO

=over 4

=item * BigMed::Data

=item * BigMed::Pointer

=item * BigMed::MiniContent

=back

=head1 AUTHOR & COPYRIGHTS

This module and all Big Medium modules are copyright Josh Clark
and Global Moxie. All rights reserved.

Use of this module and the Big Medium content
management system are governed by Global Moxie's software licenses
and may not be used outside of the terms and conditions outlined
there.

For more information, visit the Global Moxie website at
L<http://globalmoxie.com/>.

Big Medium and Global Moxie are service marks of Global Moxie
and Josh Clark. All rights reserved.

=cut