# ==================================================================
# Gossamer Links - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info : 087,071,086,086,085      
#   Revision : $Id: Newsletter.pm,v 1.15 2007/09/06 01:43:45 brewt Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================

# Notes about the Newsletter code:
# ================================
# Example category structure:
# a
#    b
#       c
#    d
# If a user is subscribed to a category (eg. category a), then they will
# be automatically subscribed to all the subcategories of that category
# (ie. b, c, d).  If the user is already subscribed to a subcategory
# (eg. b), then that subscription will be removed when they subscribe to
# a parent category (ie. a).  This keeps listing subscribed categories
# simple.
#
# Remember that the root category (0) is a special category and needs to be
# handled appropriately.  It is not a real category as it does not exist in
# the Category table.

package Links::Newsletter;

use strict;
use Links qw/:objects/;
use Links::SiteHTML;
use GT::Dumper;

sub handle {
# ---------------------------------------------------
# Determine what to do.
#
    my $res;
    my $action = lc $IN->param('action');

    require Links::Build;
    my $mtl = Links::Build::build('title', Links::language('LINKS_NEWSLETTER'), "$CFG->{db_cgi_url}/subscribe.cgi");

# Custom lists
    if ($IN->param('list')) {
        my $email = $IN->param('email');
        if ($email and $action eq 'subscribe') {
            $res = $PLG->dispatch('custom_list_subscribe', \&custom_list_subscribe);
        }
        elsif ($email and $action eq 'unsubscribe') {
            $res = $PLG->dispatch('custom_list_unsubscribe', \&custom_list_unsubscribe);
        }
        else {
            $res = { error => Links::language('SUBSCRIBE_ERROR') };
        }
        $res->{main_title_loop} ||= $mtl;
        print $IN->header();
        print Links::SiteHTML::display('newsletter', $res);
    }

# With the old Newsletter code, anyone could sign up to it.  This is bad since
# no e-mail validation is performed.  The new code will only allow signed up
# users to sign up.
    unless ($USER) {
        print $IN->redirect(Links::redirect_login_url('subscribe'));
        return;
    }

    my $page;
    if ($CFG->{newsletter_global_subscribe}) {
        $page = 'newsletter_global';
        if ($action eq 'subscribe') {
            $res = $PLG->dispatch('newsletter_global_sub', \&global_subscribe);
        }
        elsif ($action eq 'unsubscribe') {
            $res = $PLG->dispatch('newsletter_global_unsub', \&global_unsubscribe);
        }
    }
    elsif ($action eq 'list') {
        $page = 'newsletter_list';
    }
    elsif ($action eq 'unsubscribe') {
        $res = $PLG->dispatch('newsletter_unsubscribe', \&unsubscribe);
        $page = $IN->param('page') || 'newsletter';
    }
    elsif ($action eq 'subscribe') {
        $res = $PLG->dispatch('newsletter_subscribe', \&subscribe);
        $page = 'newsletter';
    }
    elsif ($action eq 'update') {
        $res = $PLG->dispatch('newsletter_update', \&update_subscription);
        $page = 'newsletter_browse';
    }
    else {
        $page = 'newsletter_browse';
    }
    $res->{main_title_loop} ||= $mtl;

    print $IN->header();
    print Links::SiteHTML::display($page, $res);
}

sub custom_list_subscribe {
# ---------------------------------------------------
# Subscribe to a custom list
#
    my $list = $IN->param('list');
    my $email = $IN->param('email');
    my $mli = $DB->table('MailingListIndex');
    my $ml = $DB->table('MailingList');
    unless ($mli->count({ Name => $list })) {
        return { error => Links::language('SUBSCRIBE_INVALIDLIST', $list) };
    }

    my $id = $mli->select('ID', { Name => $list })->fetchrow;

    if ($ml->count({ Email => $email, ID => $id })) {
        return { error => Links::language('SUBSCRIBE_ALREADYSUB') };
    }
    $ml->insert({ Email => $email, ID => $id });
    return { message => Links::language('SUBSCRIBE_SUCCESS') };
}

sub custom_list_unsubscribe {
# ---------------------------------------------------
# Unsubscribe from a custom list
#
    my $list = $IN->param('list');
    my $email = $IN->param('email');
    my $mli = $DB->table('MailingListIndex');
    my $ml = $DB->table('MailingList');
    unless ($mli->count({ Name => $list })) {
        return { error => Links::language('SUBSCRIBE_INVALIDLIST', $list) };
    }

    my $id = $mli->select('ID', { Name => $list })->fetchrow;

    unless ($ml->count({ Email => $email, ID => $id })) {
        return { error => Links::language('SUBSCRIBE_NOTSUB') };
    }
    $ml->delete({ Email => $email, ID => $id });
    return { message => Links::language('SUBSCRIBE_UNSUBSUCCESS') };
}

sub global_subscribe {
# ---------------------------------------------------
# Global subscribe to the newsletter.  If the admin option is enabled, then this
# will behave like the newsletter did in 2.x, where there is only one global
# newsletter.  The only difference is that only registered users can subscribe.
#
    my $ns = $DB->table('NewsletterSubscription');

    if ($ns->count({ UserID => $USER->{Username}, CategoryID => 0 })) {
        return { error => Links::language('NEWSLETTERERR_ALREADYSUB') };
    }
    _subscribe(0);
    return { message => Links::language('NEWSLETTER_SUBSCRIBED') };
}

sub global_unsubscribe {
# ---------------------------------------------------
# Unsubscribe from the newsletter.
#
    my $ns = $DB->table('NewsletterSubscription');

    if ($ns->count({ UserID => $USER->{Username}, CategoryID => 0 })) {
        _unsubscribe(0);
        return { message => Links::language('NEWSLETTER_UNSUBSCRIBED') };
    }
    return { error => Links::language('NEWSLETTERERR_NOTSUB') };
}

sub global_subscribe_info {
# ---------------------------------------------------
# Returns information about the user's newsletter subscription.
#
    return { subscribed => $DB->table('NewsletterSubscription')->count({ UserID => $USER->{Username}, CategoryID => 0 }) };
}

sub list_subscribed {
# ---------------------------------------------------
# Returns a list of categories they are subscribed to.
#
    my $ns = $DB->table('NewsletterSubscription');
    my $nsc = $DB->table('NewsletterSubscription', 'Category');

    if ($ns->count({ UserID => $USER->{Username}, CategoryID => 0 })) {
        return { subscribed => [_root()] };
    }

    $nsc->select_options("ORDER BY Full_Name");
    my $list = $nsc->select({ UserID => $USER->{Username} })->fetchall_hashref;
    return { subscribed => $list };
}

sub unsubscribe {
# ---------------------------------------------------
# Unsubscribe from one or more categories.
#
    my @unsub = $IN->param('ID');
    @unsub = @_ unless @unsub;

    return { error => Links::language('NEWSLETTERERR_NOCATSUB') } unless @unsub;

    _unsubscribe(@unsub);

    return { message => Links::language('NEWSLETTER_CATUNSUB') };
}

sub subscribe {
# ---------------------------------------------------
# Subscribe to one or more categories.
#
    my @sub = $IN->param('ID');
    @sub = @_ unless @sub;

    return { error => Links::language('NEWSLETTER_NOCATUNSUB') } unless @sub;

    _subscribe(@sub);

    return { message => Links::language('NEWSLETTER_CATSUB') };
}

sub update_subscription {
# ---------------------------------------------------
# Update a User's category subscriptions from their browse selection.
#

# These should be the original subscribe states of the categories.  S<ID> are the
# categories which they wish to be subscribed to.
    my @presub = $IN->param('subscribed');
    my @preunsub = $IN->param('unsubscribed');
    my (@sub, @unsub);

    for (@presub) {
        next if $_ =~ /\D/;
        push @unsub, $_ unless defined $IN->param("S$_");
    }
    _unsubscribe(@unsub);

    for (@preunsub) {
        next if $_ =~ /\D/;
        push @sub, $_ if defined $IN->param("S$_");
    }
    _subscribe(@sub);

    return { message => Links::language('NEWSLETTER_CATUPDATED') };
}

sub browse {
# ---------------------------------------------------
# Browse the categories.
#
    my $root = $IN->param('root') || 0;
    my $cat = $DB->table('Category');
    my $ns = $DB->table('NewsletterSubscription');
    if ($root != 0 and not $cat->count({ ID => $root })) {
        $root = 0;
    }

    my $root_cat;
    if ($root == 0) {
        $root_cat = _root();
        $root_cat->{CatDepth} = -1;
    }
    else {
        $root_cat = $cat->select({ ID => $root })->fetchrow_hashref or return { error => $GT::SQL::error };
    }

    my $tree = $cat->tree;
    my $cats;
# When root = 0, max_depth is kind of weird because there isn't actually a Category with ID = 0.
# Because of this GT::SQL::Tree doesn't handle the case where max_depth = 1 and root = 0, so
# we'll handle it ourselves.
    if ($root == 0 and $CFG->{newsletter_max_depth} == 1) {
        $cat->select_options("ORDER BY Full_Name");
        $cats = $cat->select({ FatherID => 0 })->fetchall_hashref;
    }
    else {
        $cats = $tree->children(id => $root, max_depth => ($root == 0 ? $CFG->{newsletter_max_depth} - 1 : $CFG->{newsletter_max_depth}), sort_col => 'Full_Name');
    }
# Insert the root category as the first element
    splice @$cats, 0, 0, $root_cat;
    my @parents;
    my %catids;
    for (0 .. $#$cats) {
        my $c = $cats->[$_];
# ID to $cats index mapping
        $catids{$c->{ID}}->{index} = $_;
# List of children (only ones which are shown in the trimmed tree)
        $catids{$c->{ID}}->{children} = [];
# Fix CatDepth to be relative to $root
        if ($_) {
            $c->{CatDepth} -= $root_cat->{CatDepth};
        }

# Keep track of categories which could have sub categories (that are past max_depth)
        if ($CFG->{newsletter_max_depth} > 0 and $c->{CatDepth} == $CFG->{newsletter_max_depth}) {
            $catids{$c->{ID}}->{check_child}++;
        }
        else {
            $c->{HasMoreChildren} = 0;
        }
        $c->{Subscribed} = 0;

# Find all the children
        while (@parents and @parents > $c->{CatDepth}) {
            my $p = pop @parents;
            for (@parents) {
                push @{$catids{$_}->{children}}, $p;
            }
        }
        push @parents, $c->{ID};
    }
    while (@parents) {
        my $p = pop @parents;
        for (@parents) {
            push @{$catids{$_}->{children}}, $p;
        }
    }
    $cats->[0]->{CatDepth} = 0;

    if (%catids) {
        for (keys %catids) {
            $cats->[$catids{$_}->{index}]->{Children} = $catids{$_}->{children};
        }

# Figure out which categories the user has subscribed to
        my @subscribed = $ns->select('CategoryID', { UserID => $USER->{Username}, CategoryID => [keys %catids] })->fetchall_list;
        for (@subscribed) {
            $cats->[$catids{$_}->{index}]->{Subscribed}++;
        }

# Check to see which categories have sub categories
        my @check = grep $catids{$_}->{check_child}, keys %catids;
        if (@check) {
            my $subcats = $tree->child_ids(id => \@check);
            for (keys %$subcats) {
                $cats->[$catids{$_}->{index}]->{HasMoreChildren} = @{$subcats->{$_}};
            }
        }
    }

    my %previous = (PPID => '');
    my $parent_subscribed;
    if ($root != 0) {
        my @parents = @{$tree->parent_ids(id => $root)};
        splice(@parents, 0, 0, 0);

        $parent_subscribed = $ns->count({ UserID => $USER->{Username}, CategoryID => \@parents });

        my $parent;
        if (@parents < $CFG->{newsletter_max_depth}) {
            $parent = $parents[0];
        }
        else {
            $parent = $parents[-$CFG->{newsletter_max_depth}];
        }

# Get the previous parent's info
        if ($parent == 0) {
            $parent = _root();
        }
        else {
            $parent = $cat->select({ ID => $parent })->fetchrow_hashref;
        }
        %previous = map { "PP" . $_ => $parent->{$_} } keys %$parent;
    }

    return { %previous, category => $cats, parent_subscribed => $parent_subscribed };
}

sub admin_browse {
# ---------------------------------------------------
# Browse the categories (admin side).
#
    my $root = $IN->param('root') || 0;
    my $cat = $DB->table('Category');
    my $ns = $DB->table('NewsletterSubscription');
    if ($root != 0 and not $cat->count({ ID => $root })) {
        $root = 0;
    }

    my $root_cat;
    if ($root == 0) {
        $root_cat = _root();
        $root_cat->{CatDepth} = -1;
    }
    else {
        $root_cat = $cat->select({ ID => $root })->fetchrow_hashref or return { error => $GT::SQL::error };
    }

    my $tree = $cat->tree;
    my $cats;
# root (0) isn't a 'real' category in the tree, so we have to select it ourselves
    if ($root == 0 and $CFG->{newsletter_max_depth} == 1) {
        $cat->select_options("ORDER BY Full_Name");
        $cats = $cat->select({ FatherID => 0 })->fetchall_hashref;
    }
    else {
        $cats = $tree->children(id => $root, max_depth => ($root == 0 ? $CFG->{newsletter_max_depth} - 1 : $CFG->{newsletter_max_depth}), sort_col => 'Full_Name');
    }
# Insert the root category as the first element of the list of categories
    splice @$cats, 0, 0, $root_cat;

    my %catids;
    for (0 .. $#$cats) {
        my $c = $cats->[$_];
# ID to $cats index mapping
        $catids{$c->{ID}}->{index} = $_;
# List of children (only ones which are shown in the trimmed tree)
        $catids{$c->{ID}}->{children} = [];
# Fix CatDepth to be relative to $root
        if ($_) {
            $c->{CatDepth} -= $root_cat->{CatDepth};
        }

# Keep track of categories which could have sub categories (that are past max_depth)
        if ($CFG->{newsletter_max_depth} > 0 and $c->{CatDepth} == $CFG->{newsletter_max_depth}) {
            $catids{$c->{ID}}->{check_child}++;
        }
        else {
            $c->{HasMoreChildren} = 0;
        }
        $c->{DirectSubscribers} = 0;
    }
    $cats->[0]->{CatDepth} = 0;

# Get a list of the root's parents (this is used twice below)
    my @root_parents = $root == 0 ? () : (0, @{$tree->parent_ids(id => $root)});

    if (%catids) {
# Calculate the number of direct subscribers for each category
        my %subscribers;
        $ns->select_options("GROUP BY CategoryID");
        my $sth = $ns->select('CategoryID', 'COUNT(*)', { CategoryID => [@root_parents, keys %catids] });
        while (my ($catid, $count) = $sth->fetchrow_array) {
            if (exists $catids{$catid}) {
                $cats->[$catids{$catid}->{index}]->{DirectSubscribers} = $count;
            }
# Save the counts to calculate the total subscribers
            $subscribers{$catid} = $count;
        }

# Calculate the number of subscribers for each category (if a newsletter was
# sent to this category, it would go to this many people)
        my $parents = $tree->parent_ids(id => [keys %catids]);
        for my $catid (keys %$parents) {
            for (@{$parents->{$catid}}, $catid) {
                $cats->[$catids{$catid}->{index}]->{Subscribers} += $subscribers{$_};
            }
            $cats->[$catids{$catid}->{index}]->{Subscribers} += $subscribers{0} if $catid;
        }

# Check to see which categories have sub categories
        my @check = grep $catids{$_}->{check_child}, keys %catids;
        if (@check) {
            my $subcats = $tree->child_ids(id => \@check);
            for (keys %$subcats) {
                $cats->[$catids{$_}->{index}]->{HasMoreChildren} = @{$subcats->{$_}};
            }
        }
    }

    my %previous = (PPID => '');
    if ($root != 0) {
        my $parent;
        if (@root_parents < $CFG->{newsletter_max_depth}) {
            $parent = $root_parents[0];
        }
        else {
            $parent = $root_parents[-$CFG->{newsletter_max_depth}];
        }

# Get the previous parent's info
        if ($parent == 0) {
            $parent = _root();
        }
        else {
            $parent = $cat->select({ ID => $parent })->fetchrow_hashref;
        }
        %previous = map { "PP" . $_ => $parent->{$_} } keys %$parent;
    }

    return { %previous, category => $cats };
}

sub subscriber_info {
# ---------------------------------------------------
# Returns information about the subscribers of a category.
#
    my $catid = $IN->param('ID');
    my $direct = $IN->param('direct');
    my $cat = $DB->table('Category');
    my $nsu = $DB->table('NewsletterSubscription', 'Users');

    if (not defined $catid or not ($catid == 0 or $cat->count({ ID => $catid }))) {
        return { error => 'Invalid ID' };
    }

    my $tree = $cat->tree;
    my @parents = $direct || $catid == 0 ? ($catid) : (0, @{$tree->parent_ids(id => $catid)}, $catid);

    $nsu->select_options("ORDER BY Username");
    my $subscribers = $nsu->select({ CategoryID => \@parents })->fetchall_hashref;

    return { subscribers => $subscribers };
}

sub subscription_info {
# ---------------------------------------------------
# Returns subscription information about a category.
# 0 = not subscribed
# 1 = indirectly subscribed (parent is subscribed)
# 2 = directly subscribed
#
    my $catid = $IN->param('ID') || shift;
    my $ns = $DB->table('NewsletterSubscription');
    my $tree = $DB->table('Category')->tree;

    if ($ns->count({ UserID => $USER->{Username}, CategoryID => $catid })) {
        return { SubscriptionStatus => 2 };
    }

    if ($catid == 0) {
        return { SubscriptionStatus => 0 };
    }

    my @parents = (0, @{$tree->parent_ids(id => $catid)});
    my @pids = $ns->select('CategoryID', { UserID => $USER->{Username}, CategoryID => \@parents })->fetchall_list;
    if (@pids) {
        return { SubscriptionStatus => 1 };
    }

    return { SubscriptionStatus => 0 };
}

sub _root {
# ---------------------------------------------------
# Since there is no real root category, return what a select from the Category
# table would return.
#
    my $ns = $DB->table('NewsletterSubscription');
    return {
        ID              => 0,
        Name            => Links::language('NEWSLETTER_ROOTCAT'),
        CatDepth        => 0,
        Full_Name       => Links::language('NEWSLETTER_ROOTCAT'),
        Description     => '',
        Subscribed      => $USER->{Username} ? $ns->count({ UserID => $USER->{Username}, CategoryID => 0 }) : 0,
    };
}

sub _subscribe {
# ---------------------------------------------------
# Subscribe to the categories passed in.
#
    my @sub = @_;
    return 0 unless @sub;

    my $cat = $DB->table('Category');
    my $ns = $DB->table('NewsletterSubscription');
    my $tree = $cat->tree;

# Already subscribed to root category
    if ($ns->count({ UserID => $USER->{Username}, CategoryID => 0 })) {
        return 0;
    }

    @sub = sort { $a <=> $b } @sub;
    if ($sub[0] == 0) {
        @sub = (0);
    }
    else {
# Filter out the invalid category ID's
        my @s = $cat->select('ID', { ID => \@sub })->fetchall_list;
# Filter out categories which are already subscribed to by being a subcat
        @sub = ();
        my $parents = $tree->parent_ids(id => \@s);
        for (@s) {
            unless (@{$parents->{$_}} and $ns->count({ UserID => $USER->{Username}, CategoryID => $parents->{$_} })) {
                push @sub, $_;
            }
        }
    }
    return 0 unless @sub;

# Subscribing to the root, subscribes you to all, so remove any existing subscriptions.
    $ns->delete({ UserID => $USER->{Username} }) if $sub[0] == 0;

    $ns->insert_multiple([qw/UserID CategoryID/], map { [$USER->{Username}, $_] } @sub);

# Remove any subscribed subcats of the ones we just added
    if ($sub[0] != 0) {
        my $c = $tree->child_ids(id => \@sub);
        my @subcats = map { @{$c->{$_}} } keys %$c;
        if (@subcats) {
            $ns->delete({ UserID => $USER->{Username}, CategoryID => \@subcats });
        }
    }

# FIXME need to take into account how many were deleted
    return scalar @sub;
}

sub _unsubscribe {
# ---------------------------------------------------
# Unsubscribe from categories passed in.  Returns the number of categories
# unsubscribed from.
#
    my @unsub = @_;
    return 0 unless @unsub;

    return $DB->table('NewsletterSubscription')->delete({ UserID => $USER->{Username}, CategoryID => \@unsub });
}

1;