First pass at adding key files
This commit is contained in:
		@@ -0,0 +1,394 @@
 | 
			
		||||
# ==================================================================
 | 
			
		||||
# Plugins::Auth_Facebook - Auto Generated Program Module
 | 
			
		||||
#
 | 
			
		||||
#   Plugins::Auth_Facebook
 | 
			
		||||
#   Author  : Gossamer Threads Inc. (Virginia Lo)
 | 
			
		||||
#   Version : 1.1
 | 
			
		||||
#   Updated : Wed Feb  2 10:34:55 2011
 | 
			
		||||
#
 | 
			
		||||
# ==================================================================
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package Plugins::Auth_Facebook;
 | 
			
		||||
# ==================================================================
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use GT::Base;
 | 
			
		||||
use GT::Plugins qw/STOP CONTINUE/;
 | 
			
		||||
use Links qw/:objects/;
 | 
			
		||||
use vars qw/$TAINTED $GRAPHURL $CALLBACK $AUTHURL $FBMAPPING/;
 | 
			
		||||
use GT::WWW;
 | 
			
		||||
use GT::JSON;
 | 
			
		||||
use Data::Dumper;
 | 
			
		||||
use Links::Plugins;
 | 
			
		||||
 | 
			
		||||
use open qw(:std :utf8);
 | 
			
		||||
use LWP::Simple;
 | 
			
		||||
use JSON;
 | 
			
		||||
use URI;
 | 
			
		||||
use utf8;
 | 
			
		||||
 | 
			
		||||
# Inherit from base class for debug and error methods
 | 
			
		||||
@Plugins::Auth_Facebook::ISA = qw(GT::Base);
 | 
			
		||||
 | 
			
		||||
# Your code begins here.
 | 
			
		||||
{
 | 
			
		||||
    local $^W = 0;
 | 
			
		||||
    $TAINTED = substr("$0$^X", 0, 0);
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
$GRAPHURL = "https://graph.facebook.com";
 | 
			
		||||
$AUTHURL  = $GRAPHURL . '/oauth/access_token';
 | 
			
		||||
 | 
			
		||||
$FBMAPPING = {
 | 
			
		||||
    first_name => 'prof_first_name',
 | 
			
		||||
    last_name  => 'prof_last_name',
 | 
			
		||||
    email      => 'comm_email',
 | 
			
		||||
};
 | 
			
		||||
 | 
			
		||||
# PLUGIN HOOKS
 | 
			
		||||
# ===================================================================
 | 
			
		||||
 | 
			
		||||
sub user_auth {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# ether facebook postback or user call it.
 | 
			
		||||
    #
 | 
			
		||||
    my $cfg = Links::Plugins::get_plugin_user_cfg('Auth_Facebook');
 | 
			
		||||
 | 
			
		||||
    $CALLBACK = $cfg->{fb_postback_url};
 | 
			
		||||
 | 
			
		||||
    my $redirect = $IN->param('url');
 | 
			
		||||
    my $ajax = $IN->param('ajax');
 | 
			
		||||
 | 
			
		||||
    my $cuser = $USER;
 | 
			
		||||
# Check to see if we have the facebook cookie already.
 | 
			
		||||
    $Links::fbcookie ||= get_facebook_cookie();
 | 
			
		||||
    my $code = $IN->param('code');
 | 
			
		||||
    my $connect = $IN->param('connect');
 | 
			
		||||
    if ($code) {
 | 
			
		||||
# ---------------------------------------------------------------------
 | 
			
		||||
# User has granted permission to the app to access their information.
 | 
			
		||||
# Post a request to facebook to verify the code which can be exchanged for an oauth access token
 | 
			
		||||
# ---------------------------------------------------------------------
 | 
			
		||||
# If the user authorizes your application, we redirect the user back 
 | 
			
		||||
# to the redirect URI you specified with a verification string in the 
 | 
			
		||||
# argument code, which can be exchanged for an oauth access token. 
 | 
			
		||||
# ---------------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
        if ($connect) {
 | 
			
		||||
            $CALLBACK .= "&connect=1";
 | 
			
		||||
        }
 | 
			
		||||
        my $linkid = $IN->param('linkid');
 | 
			
		||||
        if ($linkid) {
 | 
			
		||||
            $CALLBACK .= "$linkid/";
 | 
			
		||||
        }
 | 
			
		||||
        my $authurl = $AUTHURL . "?client_id=" . $cfg->{fb_appid} . "&redirect_uri=" . GT::CGI::escape($CALLBACK) .  "&client_secret=" . $cfg->{fb_secret_key} . "&code=" . $code;
 | 
			
		||||
        my $res = GT::WWW->post($authurl);
 | 
			
		||||
 | 
			
		||||
        #print $IN->header;
 | 
			
		||||
        #print "<pre>".  Dumper($res)."</pre>";
 | 
			
		||||
 | 
			
		||||
        if ($res->{content} =~ /access_token=(.+)$/) {
 | 
			
		||||
# we got the access token 
 | 
			
		||||
            my $access_token = $1;
 | 
			
		||||
            $access_token =~ s/\&.+$//g; # Fix it by removing the &epxire=[timestamp]
 | 
			
		||||
            #print $access_token . "**";
 | 
			
		||||
 | 
			
		||||
            my $id = $linkid;
 | 
			
		||||
            use Plugins::SocialMedia;
 | 
			
		||||
            my $result = Plugins::SocialMedia::post_facebook($access_token, $id);
 | 
			
		||||
            #my $result = {}; #Plugins::SocialMedia::post_facebook($access_token, $id);
 | 
			
		||||
            #print "<pre>".  Dumper($id,$result)."</pre>";
 | 
			
		||||
 | 
			
		||||
            if ($result) {
 | 
			
		||||
                if ($result->{id}) {
 | 
			
		||||
                    $DB->table('Links')->update({ facebook_published => $result->{id} }, { ID => $linkid });
 | 
			
		||||
                }
 | 
			
		||||
                elsif ($result->{error}) {
 | 
			
		||||
                    $DB->table('Links')->update({ facebook_published_message => $result->{error}->{message} }, { ID => $linkid });
 | 
			
		||||
                }
 | 
			
		||||
                $IN->param('t','dev'); #FIXME
 | 
			
		||||
                require Plugins::SocialMedia;
 | 
			
		||||
                my $link = Plugins::SocialMedia::format_link($linkid);
 | 
			
		||||
                print $IN->header;
 | 
			
		||||
                print Links::user_page('add_success_publish.html', { success => '1', built => 1, %$link });
 | 
			
		||||
                return;
 | 
			
		||||
            }
 | 
			
		||||
            else {
 | 
			
		||||
                $IN->param('t','dev'); #FIXME
 | 
			
		||||
                require Plugins::SocialMedia;
 | 
			
		||||
                my $link = Plugins::SocialMedia::format_link($id);
 | 
			
		||||
                print $IN->header;
 | 
			
		||||
                print Links::user_page('add_success_publish.html', { success => '1', built => 1, %$link });
 | 
			
		||||
                return;
 | 
			
		||||
            }
 | 
			
		||||
 | 
			
		||||
=tag
 | 
			
		||||
# get the user information
 | 
			
		||||
            my $userinfo = request_facebook_api('me','email', $access_token);
 | 
			
		||||
# check to seee if the user already in community
 | 
			
		||||
            my $user = user_by_facebook_id($userinfo->{id});
 | 
			
		||||
 | 
			
		||||
# ---------------------------------------------------------------------
 | 
			
		||||
# Now then login user with their facebook account 
 | 
			
		||||
# ---------------------------------------------------------------------
 | 
			
		||||
            if ($user) {
 | 
			
		||||
                my $cookies = [];
 | 
			
		||||
                my $remember = 1;
 | 
			
		||||
                my $username = $user->{comm_username};
 | 
			
		||||
# create community session.
 | 
			
		||||
                $user->{session} = comm_create_session( 
 | 
			
		||||
                    comm_id  => $user->{comm_id}, 
 | 
			
		||||
                    remember => $remember,
 | 
			
		||||
                    ip       => $ENV{REMOTE_ADDR} 
 | 
			
		||||
                );
 | 
			
		||||
# Get session cookies, and send user to home page or to redirection.
 | 
			
		||||
                my $session_cookies = Links::session_cookies($user, $remember ? $CFG->{session_remember_expiry} : undef);
 | 
			
		||||
                push @$cookies, @$session_cookies;
 | 
			
		||||
 | 
			
		||||
                if ($redirect) {
 | 
			
		||||
                    comm_debug("user |$username| logged in. Redirecting to |$redirect|") if ($CFG->{debug});
 | 
			
		||||
                    print $IN->header( -url => $redirect, -cookie => $cookies );
 | 
			
		||||
                    return;
 | 
			
		||||
                }
 | 
			
		||||
                else {
 | 
			
		||||
                    $user->{redirect} = $IN->cookie('fb_redirect');
 | 
			
		||||
                    comm_debug("user |$username| logged in.") if ($CFG->{debug});
 | 
			
		||||
                    $user->{session_cookie_name_user} = $user->{comm_username};
 | 
			
		||||
                    $user->{action} = 'login';
 | 
			
		||||
                    print $IN->header( -cookie => $cookies );
 | 
			
		||||
                    Links::user_page('user_logged_in.html', { %$user });
 | 
			
		||||
                    return;
 | 
			
		||||
                }
 | 
			
		||||
            }
 | 
			
		||||
            else {
 | 
			
		||||
# ---------------------------------------------------------------------
 | 
			
		||||
# Show signup form if they are not in Community but already authorize our app to access their account
 | 
			
		||||
# ---------------------------------------------------------------------
 | 
			
		||||
# Write the facebook cookies here so that we can access them again after the user
 | 
			
		||||
# provides us with username. I don't see where else this is being done.
 | 
			
		||||
# ---------------------------------------------------------------------
 | 
			
		||||
                my $cookies = [];
 | 
			
		||||
                my $remember = 1;
 | 
			
		||||
                my $facebook_cookies = facebook_cookies($userinfo, $remember ? $CFG->{session_remember_expiry} : undef);
 | 
			
		||||
                push @$cookies, @$facebook_cookies;
 | 
			
		||||
 | 
			
		||||
                if ($connect) {
 | 
			
		||||
                    if (defined $IN->cookie('fb_uid')) {
 | 
			
		||||
                        $userinfo->{facebook_userid} = $IN->cookie('fb_uid');
 | 
			
		||||
                    }
 | 
			
		||||
                    print $IN->header( -cookie => $cookies );
 | 
			
		||||
                    Links::user_page('user_connect.html', { fb_user => $userinfo, user => $cuser });
 | 
			
		||||
                    return;
 | 
			
		||||
                }
 | 
			
		||||
                print $IN->header( -cookie => $cookies );
 | 
			
		||||
                my @questions;
 | 
			
		||||
                foreach my $question (@{$CFG->{signup_questions}}) {
 | 
			
		||||
                    push @questions, { question => $question };
 | 
			
		||||
                }
 | 
			
		||||
                my $res = {
 | 
			
		||||
                    comm_question_loop => \@questions, fb_user => $userinfo, fb_signup => 1,
 | 
			
		||||
                };
 | 
			
		||||
                $res->{fancybox} = $IN->param('fancybox') ? 1 : 0;
 | 
			
		||||
                $res->{iframe} = 1;
 | 
			
		||||
                $res->{debuginfo} = { cookies => \@$cookies, %$userinfo };
 | 
			
		||||
                foreach (keys %$userinfo) {
 | 
			
		||||
                    $res->{querystr} .= "&" if ($res->{querystr});
 | 
			
		||||
                    $res->{querystr} .= $_ . "=" . $userinfo->{$_};
 | 
			
		||||
                }
 | 
			
		||||
                if ($userinfo->{birthday}) {
 | 
			
		||||
                    ($res->{prof_mon}, $res->{prof_day}, $res->{prof_year}) = split ('/', $userinfo->{birthday});
 | 
			
		||||
                    $res->{prof_month} =~ s/^0//g;
 | 
			
		||||
                    $res->{prof_day} =~ s/^0//g;
 | 
			
		||||
                }
 | 
			
		||||
                Links::user_page('user_signup_fb_popup.html', $res);
 | 
			
		||||
                return;
 | 
			
		||||
            }
 | 
			
		||||
=cut
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            print $IN->header;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    elsif ($IN->param('error')) {
 | 
			
		||||
        print $IN->header;
 | 
			
		||||
        Links::user_page('user_signup_fb_error.html', { error => $IN->param('error') });
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
# redirect user to facebook and ask for email, offline access, read access
 | 
			
		||||
# display=popup mean it's a popup format.
 | 
			
		||||
        my $cookie = [
 | 
			
		||||
        $IN->cookie(
 | 
			
		||||
            -name => "fb_redirect",
 | 
			
		||||
            -value => $redirect ? $redirect : '',
 | 
			
		||||
            -expires => undef, 
 | 
			
		||||
            -path => $CFG->{session_cookie_path} 
 | 
			
		||||
        )
 | 
			
		||||
        ];
 | 
			
		||||
        if ($IN->param('connect')) {
 | 
			
		||||
            $CALLBACK .= "&connect=1";
 | 
			
		||||
        }
 | 
			
		||||
        my $linkid = $IN->param('linkid');
 | 
			
		||||
        if ($linkid) {
 | 
			
		||||
            $CALLBACK .= "$linkid/";
 | 
			
		||||
            my $tags = $IN->param('twitter_hash_tags');
 | 
			
		||||
            my $newtags;
 | 
			
		||||
            if ($tags) {
 | 
			
		||||
                $tags =~ s/\s+//g;
 | 
			
		||||
                my @tags = split(',',$tags);
 | 
			
		||||
                for (@tags) {
 | 
			
		||||
                    $newtags .= ' #' . $_;
 | 
			
		||||
                }
 | 
			
		||||
            }
 | 
			
		||||
            $DB->table('Links')->update({ facebook_hashtags => $newtags  }, { ID => $linkid }) if ($newtags);
 | 
			
		||||
        }
 | 
			
		||||
        my $redirurl = 'https://graph.facebook.com/oauth/authorize?client_id=' . $cfg->{fb_appid} . '&redirect_uri=' . GT::CGI::escape($CALLBACK) . '&scope=email,read_stream,publish_stream,manage_pages';
 | 
			
		||||
        if (1) { # HAS to have display=popup to show "Log in to Facebook" button
 | 
			
		||||
            $redirurl .= "&display=popup";
 | 
			
		||||
        }
 | 
			
		||||
        print $IN->header( -url => $redirurl, -cookie => $cookie );
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub request_facebook_api {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# generate facebook api and make a request
 | 
			
		||||
# the request results are in json format
 | 
			
		||||
    #
 | 
			
		||||
    my ($uid, $type, $token, $publish, $args) = @_;
 | 
			
		||||
    if (!$token) {
 | 
			
		||||
        $Links::fbcookie ||= get_facebook_cookie();
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    $type ||= "feed";
 | 
			
		||||
 | 
			
		||||
    require GT::WWW;
 | 
			
		||||
    my $content;
 | 
			
		||||
    my $www = new GT::WWW;
 | 
			
		||||
# Note: apparently we need to unescape the token, not escape it.
 | 
			
		||||
# perhaps it's a difference between $token and access_token?
 | 
			
		||||
# http://drupal.org/node/905164 post #7 as of 9/29/2010
 | 
			
		||||
    my $host = $GRAPHURL;
 | 
			
		||||
    $host =~ s/^(https)?:\/\///g;
 | 
			
		||||
    $www->protocol($1);
 | 
			
		||||
    $www->host($host);
 | 
			
		||||
    if ($publish) {
 | 
			
		||||
        $www->path("/$uid/feed");
 | 
			
		||||
        $www->parameters(access_token => GT::CGI::unescape($token || $Links::fbcookie->{access_token}));
 | 
			
		||||
        $args ||= $IN->get_hash();
 | 
			
		||||
        #use Data::Dumper; print Dumper($args);
 | 
			
		||||
        for (qw/message picture name caption description link/) {
 | 
			
		||||
            $www->parameters($_ => GT::CGI::html_escape($args->{$_}), 1) if ($args->{$_} !~ /^\s*$/);
 | 
			
		||||
        }
 | 
			
		||||
        $content = $www->post();
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        my $requestpath = "/" . $uid;
 | 
			
		||||
        $requestpath .= "/" . $type if ($uid ne 'me');
 | 
			
		||||
        $www->path($requestpath);
 | 
			
		||||
        $www->parameters(access_token => GT::CGI::unescape($token || $Links::fbcookie->{access_token}));
 | 
			
		||||
        $args ||= $IN->get_hash();
 | 
			
		||||
        if ($uid ne 'me') {
 | 
			
		||||
            for (keys %$args) {
 | 
			
		||||
                next if ($_ eq 'arg');
 | 
			
		||||
                $www->parameters($_ => GT::CGI::html_escape($args->{$_}), 1) if ($args->{$_} !~ /^\s*$/);
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
        $content = $www->get();
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return unless ($content);
 | 
			
		||||
    my $data = eval { $content };
 | 
			
		||||
    return unless ($data and $data->{content});
 | 
			
		||||
    my $res = from_json($data->{content});
 | 
			
		||||
    return $res;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub get_facebook_cookie {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# return facebook cookie in hash if exists
 | 
			
		||||
    #
 | 
			
		||||
    my $cfg = Links::Plugins::get_plugin_user_cfg('Auth_Facebook');
 | 
			
		||||
    my ($app_id, $application_secret) = ($cfg->{fb_appid}, $cfg->{fb_secret_key});
 | 
			
		||||
    my $cookiename = 'fbs_' . $cfg->{fb_appid};
 | 
			
		||||
    my $cookies = {};
 | 
			
		||||
 | 
			
		||||
    if (defined $ENV{HTTP_COOKIE}) {
 | 
			
		||||
        for (split /;\s*/, $ENV{HTTP_COOKIE}) {
 | 
			
		||||
            /(.*)="?(.*)"?/ or next;
 | 
			
		||||
            my ($key, $val) = (GT::CGI::unescape($1 . $TAINTED), GT::CGI::unescape($2 . $TAINTED));
 | 
			
		||||
            if ($_ =~ /(.*)="([^"]+)+"/) {
 | 
			
		||||
                ($key, $val) = (GT::CGI::unescape($1 . $TAINTED), GT::CGI::unescape($2 . $TAINTED));
 | 
			
		||||
            }
 | 
			
		||||
            $val = [split '&', $val];
 | 
			
		||||
            foreach (@$val) {
 | 
			
		||||
                my ($k, $v) = split /=/, $_;
 | 
			
		||||
                $cookies->{$key}->{$k} = $v;
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    my $args = $cookies->{$cookiename};
 | 
			
		||||
 | 
			
		||||
    my $payload;
 | 
			
		||||
    foreach my $key (sort keys %$args) {
 | 
			
		||||
        if ($key ne 'sig') {
 | 
			
		||||
            $payload .= $key . '=' . $args->{$key};
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    require GT::MD5;
 | 
			
		||||
    my $md5 = GT::MD5::md5_hex($payload . $application_secret);
 | 
			
		||||
 | 
			
		||||
    return unless ($md5 eq $args->{'sig'});
 | 
			
		||||
    return $args;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub facebook_cookies {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# return facebook cookies, and put it into the cookies list 
 | 
			
		||||
# in case we need it later.
 | 
			
		||||
    #
 | 
			
		||||
    my ($facebookinfo, $expiry) = @_;
 | 
			
		||||
    $facebookinfo || return;
 | 
			
		||||
 | 
			
		||||
    my $cookies = [
 | 
			
		||||
    $IN->cookie(
 | 
			
		||||
        -name => "fb_uid",
 | 
			
		||||
        -value => $facebookinfo ? $facebookinfo->{id} : '',
 | 
			
		||||
        -expires => $expiry, 
 | 
			
		||||
        -path => $CFG->{session_cookie_path} 
 | 
			
		||||
    )
 | 
			
		||||
    ];
 | 
			
		||||
    if ($CFG->{session_cookie_domain}) {
 | 
			
		||||
        push @$cookies, 
 | 
			
		||||
        $IN->cookie(
 | 
			
		||||
            -name => "fb_uid",
 | 
			
		||||
            -value => $facebookinfo ? $facebookinfo->{id} : '',
 | 
			
		||||
            -expires => $expiry, 
 | 
			
		||||
            -path => $CFG->{session_cookie_path},
 | 
			
		||||
            -domain => $CFG->{session_cookie_domain}
 | 
			
		||||
        );
 | 
			
		||||
    }
 | 
			
		||||
    return $cookies;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub user_by_facebook_id {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# pass in facebook profile id and return the community user 
 | 
			
		||||
# associated with it if exists.
 | 
			
		||||
    #
 | 
			
		||||
    my $uid = shift || return;
 | 
			
		||||
    my $db = $DB->table('Users');
 | 
			
		||||
    return;
 | 
			
		||||
    my $sth = $db->select( { facebook_userid => $uid });
 | 
			
		||||
    if ($sth->rows) {
 | 
			
		||||
        my $user = $sth->fetchrow_hashref;
 | 
			
		||||
        return $user;
 | 
			
		||||
    }
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
# Always end with a 1.
 | 
			
		||||
1;
 | 
			
		||||
@@ -0,0 +1,368 @@
 | 
			
		||||
# ==================================================================
 | 
			
		||||
# Plugins::ConvertVideo - Auto Generated Program Module
 | 
			
		||||
#
 | 
			
		||||
#   Plugins::ConvertVideo
 | 
			
		||||
#   Author  : Virginia Lo
 | 
			
		||||
#   Version : 1.1
 | 
			
		||||
#   Updated : Wed Feb 21 16:05:27 2007
 | 
			
		||||
#
 | 
			
		||||
# ==================================================================
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package Plugins::ConvertVideo;
 | 
			
		||||
 | 
			
		||||
# ==================================================================
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use GT::Base;
 | 
			
		||||
use GT::Plugins qw/STOP CONTINUE/;
 | 
			
		||||
use Links qw/$CFG $IN $DB/;
 | 
			
		||||
use Links::Plugins;
 | 
			
		||||
use vars qw/$WIDTH $HEIGHT $LINKID $CONVERTBOX $CHECKCONVERTBOX/;
 | 
			
		||||
 | 
			
		||||
# Inherit from base class for debug and error methods
 | 
			
		||||
@Plugins::ConvertVideo::ISA = qw(GT::Base);
 | 
			
		||||
 | 
			
		||||
# Your code begins here! Good Luck!
 | 
			
		||||
 | 
			
		||||
# PLUGIN HOOKS
 | 
			
		||||
# ===================================================================
 | 
			
		||||
 | 
			
		||||
sub validate_link_pre {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# This subroutine will get called whenever the hook 'validate_link'
 | 
			
		||||
# is run. You should call GT::Plugins->action (STOP) if you don't
 | 
			
		||||
# want the regular code to run, otherwise the code will continue as
 | 
			
		||||
# normal.
 | 
			
		||||
#
 | 
			
		||||
    my ($link) = @_;
 | 
			
		||||
    $link = convert_video($link);
 | 
			
		||||
    return $link;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub pre_form_link {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
#
 | 
			
		||||
    my $opts = shift;
 | 
			
		||||
    if ($opts->{mode} =~ /([add|modify])_form/) {
 | 
			
		||||
        $CONVERTBOX = 1;
 | 
			
		||||
 | 
			
		||||
        if ($1 eq 'add') {
 | 
			
		||||
            $CHECKCONVERTBOX = 1;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    return $opts;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub post_form_link {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
#
 | 
			
		||||
    my @args = @_;
 | 
			
		||||
    if (($CONVERTBOX and $IN->param('db') eq 'Links')
 | 
			
		||||
        || $IN->param('action') eq 'link_add_form' 
 | 
			
		||||
        || $IN->param('action') eq 'link_modify_form')
 | 
			
		||||
    {
 | 
			
		||||
        my $checked = '';
 | 
			
		||||
        if ($IN->param('action') eq 'link_add_form' || $CHECKCONVERTBOX) {
 | 
			
		||||
            $checked = ' checked';
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        my $font = 'face="Tahoma,Arial,Helvetica" size="2"';
 | 
			
		||||
        $args[0] .=
 | 
			
		||||
qq~<p><table border=1 cellpadding=0 bgcolor="#FFFFFF" cellspacing=0 width="500"><tr><td>
 | 
			
		||||
        <table border=0 bgcolor="#FFFFFF" width="500"><tr>
 | 
			
		||||
        <td width="20%" valign="top"><font $font>Converting Video(s)?</td>
 | 
			
		||||
        <td width="80%"><font $font><input type="checkbox" name="admin_convert_video" value="1"$checked/> YES </td>
 | 
			
		||||
    </tr></table>
 | 
			
		||||
    </td></tr></table>~;
 | 
			
		||||
    }
 | 
			
		||||
    return @args;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub modify_link_pre {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# This subroutine will get called whenever the hook 'modify_link'
 | 
			
		||||
# is run. You should call GT::Plugins->action (STOP) if you don't
 | 
			
		||||
# want the regular code to run, otherwise the code will continue as
 | 
			
		||||
# normal.
 | 
			
		||||
#
 | 
			
		||||
    my @args = @_;
 | 
			
		||||
    my $link = $args[0];
 | 
			
		||||
    $LINKID = $link->{ID};
 | 
			
		||||
    return @args;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub modify_link_post {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
#
 | 
			
		||||
    my $ret = shift;
 | 
			
		||||
    if ($ret and $LINKID and $IN->param('admin_convert_video')) {
 | 
			
		||||
        my $linkdb = $DB->table('Links');
 | 
			
		||||
        my $link   = convert_video($linkdb->get($LINKID));
 | 
			
		||||
        my $res    = $linkdb->update($link, { ID => $LINKID });
 | 
			
		||||
        if (!$res) {
 | 
			
		||||
            die "Can't modify link #$LINKID: $GT::SQL::error\n";
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    return $ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub add_link_post {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
#
 | 
			
		||||
    $LINKID = shift;
 | 
			
		||||
    if ($LINKID) {
 | 
			
		||||
        &modify_link_post(1);
 | 
			
		||||
    }
 | 
			
		||||
    return $LINKID;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub convert_video {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Grab video details
 | 
			
		||||
    my ($link) = @_;
 | 
			
		||||
 | 
			
		||||
    my $linkid = $link->{ID};
 | 
			
		||||
    my $result = { ID => $linkid };
 | 
			
		||||
 | 
			
		||||
    my $linksdb = $DB->table('Links');
 | 
			
		||||
    my $cfg     = Links::Plugins::get_plugin_user_cfg('ConvertVideo');
 | 
			
		||||
 | 
			
		||||
    my $vf_field = $cfg->{video_file_field};
 | 
			
		||||
    my $ff_field = $cfg->{flash_file_field};
 | 
			
		||||
    my $thumb    = $cfg->{thumbnail_file_field};
 | 
			
		||||
    my $image    = $cfg->{image_file_field};
 | 
			
		||||
    my $url_field = $cfg->{video_url_field};
 | 
			
		||||
    
 | 
			
		||||
    if ($cfg->{flash_dimension} =~ /\s*(\d+)x(\d+)\s*/) {
 | 
			
		||||
        ($WIDTH, $HEIGHT) = ($1, $2);
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    my $url = $link->{$url_field};
 | 
			
		||||
    if ($url and $url ne '' and $url ne 'http://') {
 | 
			
		||||
        my $fh = $linksdb->file_info($image, $linkid) or return $result;
 | 
			
		||||
 | 
			
		||||
        require Plugins::SlideShow;
 | 
			
		||||
 | 
			
		||||
        # save the Image file (if required)
 | 
			
		||||
        my $fname  = Plugins::SlideShow::get_filename("$fh");
 | 
			
		||||
        my $efname = GT::CGI::escape($fname);
 | 
			
		||||
 | 
			
		||||
        my $main_fpath = $CFG->{admin_root_path} . "/tmp/work-$efname";
 | 
			
		||||
        if ($main_fpath ne "$fh") {
 | 
			
		||||
            open IMG, ">$main_fpath" or return throw_error( $! );
 | 
			
		||||
            binmode IMG;
 | 
			
		||||
            print IMG <$fh>;
 | 
			
		||||
            close IMG;
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        my $quality = 75;
 | 
			
		||||
 | 
			
		||||
        my $image_path =  $CFG->{admin_root_path} . "/tmp/image-$efname";
 | 
			
		||||
        Plugins::SlideShow::resize_image($main_fpath, $image_path, $WIDTH, $HEIGHT, $quality);
 | 
			
		||||
        $result->{$image} = GT::SQL::File->open($image_path);
 | 
			
		||||
 | 
			
		||||
        if ($cfg->{thumbnail_size} =~ /\s*(\d+)x(\d+)\s*/) {
 | 
			
		||||
            my ($thumb_width, $thumb_height) = ($1, $2);
 | 
			
		||||
            my $thumb_path =  $CFG->{admin_root_path} . "/tmp/thumbnail-$efname";
 | 
			
		||||
            Plugins::SlideShow::resize_image($main_fpath, $thumb_path, $thumb_width, $thumb_height, $quality);
 | 
			
		||||
            $result->{$thumb} = GT::SQL::File->open($thumb_path);
 | 
			
		||||
        }
 | 
			
		||||
        return $result; 
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    my $fh = $linksdb->file_info($vf_field, $linkid) or return $result;
 | 
			
		||||
    
 | 
			
		||||
    my $full_path = "$fh";
 | 
			
		||||
    my $video     = {};
 | 
			
		||||
 | 
			
		||||
    my $filename = $full_path;
 | 
			
		||||
    $filename =~ s/(.+)\/\d-([^\/]+)\.$/$2/g;
 | 
			
		||||
 | 
			
		||||
    my $flv_file_path =
 | 
			
		||||
      $CFG->{admin_root_path} . "/tmp/" . $linkid . ".flv";
 | 
			
		||||
    my $thumb_path =
 | 
			
		||||
      $CFG->{admin_root_path} . "/tmp/" . "thumbnail-" . $linkid . ".png";
 | 
			
		||||
    my $image_path =
 | 
			
		||||
      $CFG->{admin_root_path} . "/tmp/" . "image-" . $linkid . ".png";
 | 
			
		||||
 | 
			
		||||
    my $buf = `ffmpeg -i "$full_path" 2>&1`;
 | 
			
		||||
 | 
			
		||||
    if ($buf =~ /Video:\s.+\s+(\d+)x(\d+),?.*\s+(\d+)\s+(?:fps|tb)/) {
 | 
			
		||||
        $video->{width}  = $1;
 | 
			
		||||
        $video->{height} = $2;
 | 
			
		||||
        $video->{fps}    = $3;
 | 
			
		||||
 | 
			
		||||
        if ($buf =~ /Duration:\s+(\d+):(\d+):(\d+).+bitrate:\s+(\d+)\s+kb\/s/)
 | 
			
		||||
        {
 | 
			
		||||
            $video->{duration} = $1 * 3600 + $2 * 60 + $3;
 | 
			
		||||
            $video->{bitrate}  = $4;
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
    } else {
 | 
			
		||||
        warn "Couldn't get video info";
 | 
			
		||||
        return $result;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    # Figure out any scaling we might need to do
 | 
			
		||||
    if ($video->{width} > $WIDTH and $video->{height} > $HEIGHT) {
 | 
			
		||||
 | 
			
		||||
        # Choose the larger dimension to scale down
 | 
			
		||||
        if ($video->{width} / $WIDTH > $video->{height} / $HEIGHT) {
 | 
			
		||||
            $video->{out_height} =
 | 
			
		||||
              int($video->{height} * $WIDTH / $video->{width});
 | 
			
		||||
            $video->{out_width} = $WIDTH;
 | 
			
		||||
        } else {
 | 
			
		||||
            $video->{out_width} =
 | 
			
		||||
              int($video->{width} * $HEIGHT / $video->{height});
 | 
			
		||||
            $video->{out_height} = $HEIGHT;
 | 
			
		||||
        }
 | 
			
		||||
    } elsif ($video->{width} > $WIDTH) {
 | 
			
		||||
        $video->{out_height} = int($HEIGHT * $WIDTH / $video->{width});
 | 
			
		||||
        $video->{out_width}  = $WIDTH;
 | 
			
		||||
    } elsif ($video->{height} > $HEIGHT) {
 | 
			
		||||
        $video->{out_height} = $HEIGHT;
 | 
			
		||||
        $video->{out_width}  = int($video->{height} * $WIDTH / $HEIGHT);
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    # Source dimensions are smaller than output
 | 
			
		||||
    else {
 | 
			
		||||
        $video->{out_height} = $video->{height};
 | 
			
		||||
        $video->{out_width}  = $video->{width};
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    $video->{out_height}++ if $video->{out_height} % 2;
 | 
			
		||||
    $video->{out_width}++  if $video->{out_width} % 2;
 | 
			
		||||
 | 
			
		||||
    $video->{out_padtop} = int(($HEIGHT - $video->{out_height}) / 2);
 | 
			
		||||
    $video->{out_padtop}-- if $video->{out_padtop} % 2;
 | 
			
		||||
    $video->{out_padbottom} =
 | 
			
		||||
      $HEIGHT - $video->{out_height} - $video->{out_padtop};
 | 
			
		||||
 | 
			
		||||
    $video->{out_padleft} = int(($WIDTH - $video->{out_width}) / 2);
 | 
			
		||||
    $video->{out_padleft}-- if $video->{out_padleft} % 2;
 | 
			
		||||
    $video->{out_padright} =
 | 
			
		||||
      $WIDTH - $video->{out_width} - $video->{out_padleft};
 | 
			
		||||
 | 
			
		||||
    # Encode the video
 | 
			
		||||
    system(
 | 
			
		||||
        "ffmpeg",
 | 
			
		||||
        '-i', "$full_path",
 | 
			
		||||
        '-y',    # overwrite
 | 
			
		||||
                 # video options
 | 
			
		||||
        '-vf',  "scale=$video->{out_width}:$video->{out_height},pad='$WIDTH:$HEIGHT:$video->{out_padleft}:$video->{out_padtop}'",  
 | 
			
		||||
 | 
			
		||||
        # audio options
 | 
			
		||||
        '-ar', 22050,    # audio sampling rate (Hz)
 | 
			
		||||
        '-ab', 64,       # audio bitrate (kb/s)
 | 
			
		||||
        '-ac', 2,        # audio channels
 | 
			
		||||
                         # encoding options
 | 
			
		||||
                         #            '-b', 100000, # video bitrate (b/s)
 | 
			
		||||
        '-qscale',
 | 
			
		||||
        $cfg->{flash_quality} || 6,    # quality scale (1 [best] - 31 [worst])
 | 
			
		||||
                                       # watermark
 | 
			
		||||
          #            '-vhook', '/usr/lib/vhook/watermark.so -f admin/water3.gif',
 | 
			
		||||
          # output
 | 
			
		||||
        "$flv_file_path",
 | 
			
		||||
   );
 | 
			
		||||
 | 
			
		||||
=tag
 | 
			
		||||
# video options
 | 
			
		||||
                '-r', $video->{fps}, # frame rate
 | 
			
		||||
                '-s', "$video->{out_width2}x$video->{out_height2}", # frame size
 | 
			
		||||
                '-padtop', $video->{out_padtop},
 | 
			
		||||
                '-padbottom', $video->{out_padbottom},
 | 
			
		||||
                '-padleft', $video->{out_padleft},
 | 
			
		||||
                '-padright', $video->{out_padright},
 | 
			
		||||
=cut
 | 
			
		||||
 | 
			
		||||
# -----------------------------------------------------------------------------------------
 | 
			
		||||
# -----------------------------------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
    # Generate a thumbnail (a quarter of the way through)
 | 
			
		||||
    my $when  = int($video->{duration} * 0.25);
 | 
			
		||||
    my $hours = int($when / 3600);
 | 
			
		||||
    my $mins  = int($when / 60) - $hours * 60;
 | 
			
		||||
    my $secs  = $when - $hours * 3600 - $mins * 60;
 | 
			
		||||
    $when = sprintf("%.2d:%.2d:%.2d", $hours, $mins, $secs);
 | 
			
		||||
 | 
			
		||||
    if ($cfg->{thumbnail_size} and $cfg->{thumbnail_file_field}) {
 | 
			
		||||
        system(
 | 
			
		||||
            "ffmpeg",
 | 
			
		||||
            '-i', "$flv_file_path",
 | 
			
		||||
            '-y',    # overwrite
 | 
			
		||||
            '-vframes', 1,       # record 1 frame
 | 
			
		||||
            '-ss',      $when,
 | 
			
		||||
            '-an',               # no audio
 | 
			
		||||
            '-vcodec', 'png',
 | 
			
		||||
            '-f',      'rawvideo',
 | 
			
		||||
            '-s',      $cfg->{thumbnail_size},
 | 
			
		||||
            "$thumb_path",
 | 
			
		||||
       );
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    system(
 | 
			
		||||
        "ffmpeg",
 | 
			
		||||
        '-i', "$flv_file_path",
 | 
			
		||||
        '-y',                    # overwrite
 | 
			
		||||
        '-vframes', 1,           # record 1 frame
 | 
			
		||||
        '-ss',      $when,
 | 
			
		||||
        '-an',                   # no audio
 | 
			
		||||
        '-vcodec', 'png',
 | 
			
		||||
        '-f',      'rawvideo',
 | 
			
		||||
        '-s',      "${WIDTH}x$HEIGHT",    # frame size
 | 
			
		||||
        "$image_path",
 | 
			
		||||
   );
 | 
			
		||||
 | 
			
		||||
    $result->{$ff_field} = GT::SQL::File->open($flv_file_path);
 | 
			
		||||
    $result->{$image}         = GT::SQL::File->open($image_path);
 | 
			
		||||
    $result->{$thumb}      = GT::SQL::File->open($thumb_path)
 | 
			
		||||
      if ($cfg->{thumbnail_file_field} and $thumb_path);
 | 
			
		||||
 | 
			
		||||
    return $result;
 | 
			
		||||
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub get_file_path {
 | 
			
		||||
# ---------------------------------------------------------------------------
 | 
			
		||||
# return file path of a file column
 | 
			
		||||
#
 | 
			
		||||
    my $cfg        = Links::Plugins::get_plugin_user_cfg('ConvertVideo');
 | 
			
		||||
    my $id         = shift;
 | 
			
		||||
    my $field_name = shift || "flash_file_field";
 | 
			
		||||
    my $field      = $cfg->{$field_name};
 | 
			
		||||
    my $wantpath   = shift || 0;
 | 
			
		||||
    my $fh         = $DB->table('Links')->file_info($field, $id);
 | 
			
		||||
    return { $field_name . "_path" => '' } if (!$fh);
 | 
			
		||||
    my $fdir      = $fh->File_Directory();
 | 
			
		||||
    my $full_path = "$fh";
 | 
			
		||||
    my $rel_path  = $full_path;
 | 
			
		||||
    $rel_path =~ s,$fdir,,;
 | 
			
		||||
    $rel_path =~ s,%,%25,g;
 | 
			
		||||
 | 
			
		||||
    if ($wantpath) {
 | 
			
		||||
        return $rel_path;
 | 
			
		||||
    }
 | 
			
		||||
    return { $field_name . "_path" => $cfg->{video_url} . $rel_path };
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub get_flash_dimension {
 | 
			
		||||
    my $cfg    = Links::Plugins::get_plugin_user_cfg('ConvertVideo');
 | 
			
		||||
    my $width  = 320;
 | 
			
		||||
    my $height = 240;
 | 
			
		||||
    if ($cfg->{flash_dimension} =~ /\s*(\d+)x(\d+)\s*/) {
 | 
			
		||||
        ($width, $height) = ($1, $2);
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return { 'video_width' => $width, 'video_height' => $height };
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub get_video_max_size {
 | 
			
		||||
    my $cfg        = Links::Plugins::get_plugin_user_cfg('ConvertVideo');
 | 
			
		||||
    my $field_name = $cfg->{video_file_field};
 | 
			
		||||
    my %cols = $DB->table('Links')->_file_cols();
 | 
			
		||||
    return $cols{$field_name}->{file_max_size};
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
# Always end with a 1.
 | 
			
		||||
1;
 | 
			
		||||
@@ -0,0 +1,336 @@
 | 
			
		||||
# ==================================================================
 | 
			
		||||
# Plugins::ConvertVideo - Auto Generated Program Module
 | 
			
		||||
#
 | 
			
		||||
#   Plugins::ConvertVideo
 | 
			
		||||
#   Author  : Virginia Lo
 | 
			
		||||
#   Version : 1.1
 | 
			
		||||
#   Updated : Wed Feb 21 16:05:27 2007
 | 
			
		||||
#
 | 
			
		||||
# ==================================================================
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package Plugins::ConvertVideo;
 | 
			
		||||
 | 
			
		||||
# ==================================================================
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use GT::Base;
 | 
			
		||||
use GT::Plugins qw/STOP CONTINUE/;
 | 
			
		||||
use Links qw/$CFG $IN $DB/;
 | 
			
		||||
use Links::Plugins;
 | 
			
		||||
use vars qw/$WIDTH $HEIGHT $LINKID $CONVERTBOX $CHECKCONVERTBOX/;
 | 
			
		||||
 | 
			
		||||
# Inherit from base class for debug and error methods
 | 
			
		||||
@Plugins::ConvertVideo::ISA = qw(GT::Base);
 | 
			
		||||
 | 
			
		||||
# Your code begins here! Good Luck!
 | 
			
		||||
 | 
			
		||||
# PLUGIN HOOKS
 | 
			
		||||
# ===================================================================
 | 
			
		||||
 | 
			
		||||
sub validate_link_pre {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# This subroutine will get called whenever the hook 'validate_link'
 | 
			
		||||
# is run. You should call GT::Plugins->action (STOP) if you don't
 | 
			
		||||
# want the regular code to run, otherwise the code will continue as
 | 
			
		||||
# normal.
 | 
			
		||||
#
 | 
			
		||||
    my ($link) = @_;
 | 
			
		||||
    $link = convert_video($link);
 | 
			
		||||
    return $link;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub pre_form_link {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
#
 | 
			
		||||
    my $opts = shift;
 | 
			
		||||
    if ($opts->{mode} =~ /([add|modify])_form/) {
 | 
			
		||||
        $CONVERTBOX = 1;
 | 
			
		||||
 | 
			
		||||
        if ($1 eq 'add') {
 | 
			
		||||
            $CHECKCONVERTBOX = 1;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    return $opts;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub post_form_link {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
#
 | 
			
		||||
    my @args = @_;
 | 
			
		||||
    if (($CONVERTBOX and $IN->param('db') eq 'Links')
 | 
			
		||||
        || $IN->param('action') eq 'link_add_form' 
 | 
			
		||||
        || $IN->param('action') eq 'link_modify_form')
 | 
			
		||||
    {
 | 
			
		||||
        my $checked = '';
 | 
			
		||||
        if ($IN->param('action') eq 'link_add_form' || $CHECKCONVERTBOX) {
 | 
			
		||||
            $checked = ' checked';
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        my $font = 'face="Tahoma,Arial,Helvetica" size="2"';
 | 
			
		||||
        $args[0] .=
 | 
			
		||||
qq~<p><table border=1 cellpadding=0 bgcolor="#FFFFFF" cellspacing=0 width="500"><tr><td>
 | 
			
		||||
        <table border=0 bgcolor="#FFFFFF" width="500"><tr>
 | 
			
		||||
        <td width="20%" valign="top"><font $font>Converting Video(s)?</td>
 | 
			
		||||
        <td width="80%"><font $font><input type="checkbox" name="admin_convert_video" value="1"$checked/> YES </td>
 | 
			
		||||
    </tr></table>
 | 
			
		||||
    </td></tr></table>~;
 | 
			
		||||
    }
 | 
			
		||||
    return @args;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub modify_link_pre {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# This subroutine will get called whenever the hook 'modify_link'
 | 
			
		||||
# is run. You should call GT::Plugins->action (STOP) if you don't
 | 
			
		||||
# want the regular code to run, otherwise the code will continue as
 | 
			
		||||
# normal.
 | 
			
		||||
#
 | 
			
		||||
    my @args = @_;
 | 
			
		||||
    my $link = $args[0];
 | 
			
		||||
    $LINKID = $link->{ID};
 | 
			
		||||
    return @args;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub modify_link_post {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
#
 | 
			
		||||
    my $ret = shift;
 | 
			
		||||
    if ($ret and $LINKID and $IN->param('admin_convert_video')) {
 | 
			
		||||
        my $linkdb = $DB->table('Links');
 | 
			
		||||
        my $link   = convert_video({ ID => $LINKID });
 | 
			
		||||
        my $res    = $linkdb->update($link, { ID => $LINKID });
 | 
			
		||||
        if (!$res) {
 | 
			
		||||
            die "Can't modify link #$LINKID: $GT::SQL::error\n";
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    return $ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub add_link_post {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
#
 | 
			
		||||
    $LINKID = shift;
 | 
			
		||||
    if ($LINKID) {
 | 
			
		||||
        &modify_link_post(1);
 | 
			
		||||
    }
 | 
			
		||||
    return $LINKID;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub convert_video {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Grab video details
 | 
			
		||||
    my ($link) = @_;
 | 
			
		||||
 | 
			
		||||
    my $linksdb = $DB->table('Links');
 | 
			
		||||
    my $cfg     = Links::Plugins::get_plugin_user_cfg('ConvertVideo');
 | 
			
		||||
 | 
			
		||||
    my $vf_field = $cfg->{video_file_field};
 | 
			
		||||
    my $ff_field = $cfg->{flash_file_field};
 | 
			
		||||
    my $thumb    = $cfg->{thumbnail_file_field};
 | 
			
		||||
    my $image    = $cfg->{image_file_field};
 | 
			
		||||
 | 
			
		||||
    my $fh = $linksdb->file_info($vf_field, $link->{ID}) or return $link;
 | 
			
		||||
 | 
			
		||||
    my $full_path = "$fh";
 | 
			
		||||
    my $video     = {};
 | 
			
		||||
 | 
			
		||||
    my $filename = $full_path;
 | 
			
		||||
    $filename =~ s/(.+)\/\d-([^\/]+)\.$/$2/g;
 | 
			
		||||
 | 
			
		||||
    my $flv_file_path =
 | 
			
		||||
      $CFG->{admin_root_path} . "/tmp/" . $link->{ID} . ".flv";
 | 
			
		||||
    my $thumb_path =
 | 
			
		||||
      $CFG->{admin_root_path} . "/tmp/" . "thumbnail-" . $link->{ID} . ".png";
 | 
			
		||||
    my $image_path =
 | 
			
		||||
      $CFG->{admin_root_path} . "/tmp/" . "image-" . $link->{ID} . ".png";
 | 
			
		||||
 | 
			
		||||
    my $buf = `ffmpeg -i "$full_path" 2>&1`;
 | 
			
		||||
 | 
			
		||||
    if ($cfg->{flash_dimension} =~ /\s*(\d+)x(\d+)\s*/) {
 | 
			
		||||
        ($WIDTH, $HEIGHT) = ($1, $2);
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    if ($buf =~ /Video:.+\s+(\d+)x(\d+),?.*\s+(\d+\.\d+)\s+(?:fps|tb)/) {
 | 
			
		||||
        $video->{width}  = $1;
 | 
			
		||||
        $video->{height} = $2;
 | 
			
		||||
        $video->{fps}    = $3;
 | 
			
		||||
 | 
			
		||||
        if ($buf =~ /Duration:\s+(\d+):(\d+):(\d+).+bitrate:\s+(\d+)\s+kb\/s/)
 | 
			
		||||
        {
 | 
			
		||||
            $video->{duration} = $1 * 3600 + $2 * 60 + $3;
 | 
			
		||||
            $video->{bitrate}  = $4;
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
    } else {
 | 
			
		||||
        warn "Couldn't get video info";
 | 
			
		||||
        return $link;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    # Figure out any scaling we might need to do
 | 
			
		||||
    if ($video->{width} > $WIDTH and $video->{height} > $HEIGHT) {
 | 
			
		||||
 | 
			
		||||
        # Choose the larger dimension to scale down
 | 
			
		||||
        if ($video->{width} / $WIDTH > $video->{height} / $HEIGHT) {
 | 
			
		||||
            $video->{out_height} =
 | 
			
		||||
              int($video->{height} * $WIDTH / $video->{width});
 | 
			
		||||
            $video->{out_width} = $WIDTH;
 | 
			
		||||
        } else {
 | 
			
		||||
            $video->{out_width} =
 | 
			
		||||
              int($video->{width} * $HEIGHT / $video->{height});
 | 
			
		||||
            $video->{out_height} = $HEIGHT;
 | 
			
		||||
        }
 | 
			
		||||
    } elsif ($video->{width} > $WIDTH) {
 | 
			
		||||
        $video->{out_height} = int($HEIGHT * $WIDTH / $video->{width});
 | 
			
		||||
        $video->{out_width}  = $WIDTH;
 | 
			
		||||
    } elsif ($video->{height} > $HEIGHT) {
 | 
			
		||||
        $video->{out_height} = $HEIGHT;
 | 
			
		||||
        $video->{out_width}  = int($video->{height} * $WIDTH / $HEIGHT);
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    # Source dimensions are smaller than output
 | 
			
		||||
    else {
 | 
			
		||||
        $video->{out_height} = $video->{height};
 | 
			
		||||
        $video->{out_width}  = $video->{width};
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    $video->{out_height}++ if $video->{out_height} % 2;
 | 
			
		||||
    $video->{out_width}++  if $video->{out_width} % 2;
 | 
			
		||||
 | 
			
		||||
    $video->{out_padtop} = int(($HEIGHT - $video->{out_height}) / 2);
 | 
			
		||||
    $video->{out_padtop}-- if $video->{out_padtop} % 2;
 | 
			
		||||
    $video->{out_padbottom} =
 | 
			
		||||
      $HEIGHT - $video->{out_height} - $video->{out_padtop};
 | 
			
		||||
 | 
			
		||||
    $video->{out_padleft} = int(($WIDTH - $video->{out_width}) / 2);
 | 
			
		||||
    $video->{out_padleft}-- if $video->{out_padleft} % 2;
 | 
			
		||||
    $video->{out_padright} =
 | 
			
		||||
      $WIDTH - $video->{out_width} - $video->{out_padleft};
 | 
			
		||||
 | 
			
		||||
    # Encode the video
 | 
			
		||||
    system(
 | 
			
		||||
        "ffmpeg",
 | 
			
		||||
        '-i', "$full_path",
 | 
			
		||||
        '-y',    # overwrite
 | 
			
		||||
                 # video options
 | 
			
		||||
        '-r',         $video->{fps},                                # frame rate
 | 
			
		||||
        '-s',         "$video->{out_width}x$video->{out_height}",   # frame size
 | 
			
		||||
        '-padtop',    $video->{out_padtop},
 | 
			
		||||
        '-padbottom', $video->{out_padbottom},
 | 
			
		||||
        '-padleft',   $video->{out_padleft},
 | 
			
		||||
        '-padright',  $video->{out_padright},
 | 
			
		||||
 | 
			
		||||
        # audio options
 | 
			
		||||
        '-ar', 22050,    # audio sampling rate (Hz)
 | 
			
		||||
        '-ab', 64,       # audio bitrate (kb/s)
 | 
			
		||||
        '-ac', 2,        # audio channels
 | 
			
		||||
                         # encoding options
 | 
			
		||||
                         #            '-b', 100000, # video bitrate (b/s)
 | 
			
		||||
        '-qscale',
 | 
			
		||||
        $cfg->{flash_quality} || 6,    # quality scale (1 [best] - 31 [worst])
 | 
			
		||||
                                       # watermark
 | 
			
		||||
          #            '-vhook', '/usr/lib/vhook/watermark.so -f admin/water3.gif',
 | 
			
		||||
          # output
 | 
			
		||||
        "$flv_file_path",
 | 
			
		||||
   );
 | 
			
		||||
 | 
			
		||||
=tag
 | 
			
		||||
# video options
 | 
			
		||||
                '-r', $video->{fps}, # frame rate
 | 
			
		||||
                '-s', "$video->{out_width2}x$video->{out_height2}", # frame size
 | 
			
		||||
                '-padtop', $video->{out_padtop},
 | 
			
		||||
                '-padbottom', $video->{out_padbottom},
 | 
			
		||||
                '-padleft', $video->{out_padleft},
 | 
			
		||||
                '-padright', $video->{out_padright},
 | 
			
		||||
=cut
 | 
			
		||||
 | 
			
		||||
# -----------------------------------------------------------------------------------------
 | 
			
		||||
# -----------------------------------------------------------------------------------------
 | 
			
		||||
 | 
			
		||||
    # Generate a thumbnail (a quarter of the way through)
 | 
			
		||||
    my $when  = int($video->{duration} * 0.25);
 | 
			
		||||
    my $hours = int($when / 3600);
 | 
			
		||||
    my $mins  = int($when / 60) - $hours * 60;
 | 
			
		||||
    my $secs  = $when - $hours * 3600 - $mins * 60;
 | 
			
		||||
    $when = sprintf("%.2d:%.2d:%.2d", $hours, $mins, $secs);
 | 
			
		||||
 | 
			
		||||
    if ($cfg->{thumbnail_size} and $cfg->{thumbnail_file_field}) {
 | 
			
		||||
        system(
 | 
			
		||||
            "ffmpeg",
 | 
			
		||||
            '-i', "$flv_file_path",
 | 
			
		||||
            '-y',    # overwrite
 | 
			
		||||
            '-vframes', 1,       # record 1 frame
 | 
			
		||||
            '-ss',      $when,
 | 
			
		||||
            '-an',               # no audio
 | 
			
		||||
            '-vcodec', 'png',
 | 
			
		||||
            '-f',      'rawvideo',
 | 
			
		||||
            '-s',      $cfg->{thumbnail_size},
 | 
			
		||||
            "$thumb_path",
 | 
			
		||||
       );
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    system(
 | 
			
		||||
        "ffmpeg",
 | 
			
		||||
        '-i', "$flv_file_path",
 | 
			
		||||
        '-y',                    # overwrite
 | 
			
		||||
        '-vframes', 1,           # record 1 frame
 | 
			
		||||
        '-ss',      $when,
 | 
			
		||||
        '-an',                   # no audio
 | 
			
		||||
        '-vcodec', 'png',
 | 
			
		||||
        '-f',      'rawvideo',
 | 
			
		||||
        '-s',      "${WIDTH}x$HEIGHT",    # frame size
 | 
			
		||||
        "$image_path",
 | 
			
		||||
   );
 | 
			
		||||
 | 
			
		||||
    $link->{$ff_field} = GT::SQL::File->open($flv_file_path);
 | 
			
		||||
    $link->{$image}         = GT::SQL::File->open($image_path);
 | 
			
		||||
    $link->{$thumb}      = GT::SQL::File->open($thumb_path)
 | 
			
		||||
      if ($cfg->{thumbnail_file_field} and $thumb_path);
 | 
			
		||||
 | 
			
		||||
    return $link;
 | 
			
		||||
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub get_file_path {
 | 
			
		||||
# ---------------------------------------------------------------------------
 | 
			
		||||
# return file path of a file column
 | 
			
		||||
#
 | 
			
		||||
    my $cfg        = Links::Plugins::get_plugin_user_cfg('ConvertVideo');
 | 
			
		||||
    my $id         = shift;
 | 
			
		||||
    my $field_name = shift || "flash_file_field";
 | 
			
		||||
    my $field      = $cfg->{$field_name};
 | 
			
		||||
    my $wantpath   = shift || 0;
 | 
			
		||||
    my $fh         = $DB->table('Links')->file_info($field, $id);
 | 
			
		||||
    return { $field_name . "_path" => '' } if (!$fh);
 | 
			
		||||
    my $fdir      = $fh->File_Directory();
 | 
			
		||||
    my $full_path = "$fh";
 | 
			
		||||
    my $rel_path  = $full_path;
 | 
			
		||||
    $rel_path =~ s,$fdir,,;
 | 
			
		||||
    $rel_path =~ s,%,%25,g;
 | 
			
		||||
 | 
			
		||||
    if ($wantpath) {
 | 
			
		||||
        return $rel_path;
 | 
			
		||||
    }
 | 
			
		||||
    return { $field_name . "_path" => $cfg->{video_url} . $rel_path };
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub get_flash_dimension {
 | 
			
		||||
    my $cfg    = Links::Plugins::get_plugin_user_cfg('ConvertVideo');
 | 
			
		||||
    my $width  = 320;
 | 
			
		||||
    my $height = 240;
 | 
			
		||||
    if ($cfg->{flash_dimension} =~ /\s*(\d+)x(\d+)\s*/) {
 | 
			
		||||
        ($width, $height) = ($1, $2);
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return { 'video_width' => $width, 'video_height' => $height };
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub get_video_max_size {
 | 
			
		||||
    my $cfg        = Links::Plugins::get_plugin_user_cfg('ConvertVideo');
 | 
			
		||||
    my $field_name = $cfg->{video_file_field};
 | 
			
		||||
    my %cols = $DB->table('Links')->_file_cols();
 | 
			
		||||
    return $cols{$field_name}->{file_max_size};
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
# Always end with a 1.
 | 
			
		||||
1;
 | 
			
		||||
@@ -0,0 +1,66 @@
 | 
			
		||||
# ==================================================================
 | 
			
		||||
# Plugins::HandlePage - Auto Generated Program Module
 | 
			
		||||
#
 | 
			
		||||
#   Plugins::HandlePage
 | 
			
		||||
#   Author  : Gossamer Threads Inc. (Virginia Lo)
 | 
			
		||||
#   Version : 1.0
 | 
			
		||||
#   Updated : Tue Jun  7 15:32:59 2011
 | 
			
		||||
#
 | 
			
		||||
# ==================================================================
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package Plugins::HandlePage;
 | 
			
		||||
# ==================================================================
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use GT::Base;
 | 
			
		||||
use GT::Plugins qw/STOP CONTINUE/;
 | 
			
		||||
use Links qw/:objects/;
 | 
			
		||||
use Links::SiteHTML;
 | 
			
		||||
 | 
			
		||||
# Inherit from base class for debug and error methods
 | 
			
		||||
@Plugins::HandlePage::ISA = qw(GT::Base);
 | 
			
		||||
 | 
			
		||||
# Your code begins here.
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
# PLUGIN HOOKS
 | 
			
		||||
# ===================================================================
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
sub pre_handle_page {
 | 
			
		||||
# -----------------------------------------------------------------------------
 | 
			
		||||
# This subroutine will be called whenever the hook 'handle_page' is run.  You
 | 
			
		||||
# should call $PLG->action(STOP) if you don't want the regular
 | 
			
		||||
# 'handle_page' code to run, otherwise the code will continue as normal.
 | 
			
		||||
#
 | 
			
		||||
    my (@args) = @_;
 | 
			
		||||
 | 
			
		||||
# Do something useful here
 | 
			
		||||
    if (my $page2 = $IN->param('page2')) {
 | 
			
		||||
        $page2 =~ /.+_(\d+).html/;
 | 
			
		||||
        my $id = $1;
 | 
			
		||||
        my $linksdb = $DB->table('Links','CatLinks');
 | 
			
		||||
        my $link = $linksdb->select( { LinkID => $id })->fetchrow_hashref;
 | 
			
		||||
        if ($link) {
 | 
			
		||||
            $link = Links::SiteHTML::tags('link',$link, $link->{CategoryID});
 | 
			
		||||
            $link->{detailed_url} =~ /$CFG->{build_root_url}\/(.+)$/;
 | 
			
		||||
            my $match = $1;
 | 
			
		||||
            if ($page2 ne $match) {
 | 
			
		||||
                print $IN->redirect( -url => $link->{detailed_url}, -permanent => 1 );
 | 
			
		||||
                #print $IN->header . $page2 . "<br />";
 | 
			
		||||
                #print $link->{detailed_url} . " ($page2) should be redirected.";
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            print "Status: 404" . $GT::CGI::EOL;
 | 
			
		||||
            print $IN->header();
 | 
			
		||||
            print Links::SiteHTML::display('error', { error => Links::language('PAGE_INVALIDDETAIL',$id) });
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return @args;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
# Always end with a 1.
 | 
			
		||||
1;
 | 
			
		||||
										
											Binary file not shown.
										
									
								
							
										
											Binary file not shown.
										
									
								
							
										
											Binary file not shown.
										
									
								
							
										
											Binary file not shown.
										
									
								
							
										
											Binary file not shown.
										
									
								
							
										
											Binary file not shown.
										
									
								
							
										
											Binary file not shown.
										
									
								
							@@ -0,0 +1,231 @@
 | 
			
		||||
# ==================================================================
 | 
			
		||||
# Plugins::MostPopular - Auto Generated Program Module
 | 
			
		||||
#
 | 
			
		||||
#   Plugins::MostPopular
 | 
			
		||||
#   Author  : Virginia Lo
 | 
			
		||||
#   Version : 1.0
 | 
			
		||||
#   Updated : Tue Sep  4 11:23:30 2007
 | 
			
		||||
#
 | 
			
		||||
# ==================================================================
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package Plugins::MostPopular;
 | 
			
		||||
# ==================================================================
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use GT::Base;
 | 
			
		||||
use GT::Plugins qw/STOP CONTINUE/;
 | 
			
		||||
use Links qw/:objects/;
 | 
			
		||||
 | 
			
		||||
# Inherit from base class for debug and error methods
 | 
			
		||||
@Plugins::MostPopular::ISA = qw(GT::Base);
 | 
			
		||||
 | 
			
		||||
# Your code begins here.
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
# PLUGIN HOOKS
 | 
			
		||||
# ===================================================================
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
sub jump_link {
 | 
			
		||||
# -----------------------------------------------------------------------------
 | 
			
		||||
# This subroutine will be called whenever the hook 'jump_link' is run.  You
 | 
			
		||||
# should call $PLG->action(STOP) if you don't want the regular
 | 
			
		||||
# 'jump_link' code to run, otherwise the code will continue as normal.
 | 
			
		||||
#
 | 
			
		||||
    $PLG->action(STOP);
 | 
			
		||||
    my $links = $DB->table('Links');
 | 
			
		||||
    my $id = $IN->param('ID') || $IN->param('Detailed');
 | 
			
		||||
    my $action = $IN->param('action') || '';
 | 
			
		||||
    my $goto = '';
 | 
			
		||||
    my $rec = {};
 | 
			
		||||
 | 
			
		||||
    if ($CFG->{framed_jump} and $id and $action eq 'jump_frame') {
 | 
			
		||||
        my $error;
 | 
			
		||||
        if ($id !~ /^\d+$/) {
 | 
			
		||||
            $error = Links::language('JUMP_INVALIDID', $id);
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            $rec = $links->select({ ID => $id }, VIEWABLE)->fetchrow_hashref;
 | 
			
		||||
            unless ($rec) {
 | 
			
		||||
                $error = Links::language('JUMP_INVALIDID', $id);
 | 
			
		||||
                $rec = {};
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($CFG->{build_detailed}) {
 | 
			
		||||
                $rec->{detailed_url} = "$CFG->{build_detail_url}/" . $links->detailed_url($id);
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
        print $IN->header();
 | 
			
		||||
        print Links::SiteHTML::display('jump_frame', { error => $error, %$rec });
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
# If we are chosing a random link, then get the total and go to one at random.
 | 
			
		||||
    if (lc $id eq "random") {
 | 
			
		||||
        my $offset = int rand $links->count(VIEWABLE);
 | 
			
		||||
        $links->select_options("LIMIT 1 OFFSET $offset");
 | 
			
		||||
        my $sth = $links->select(qw/ID URL/ => VIEWABLE);
 | 
			
		||||
        ($id, $goto) = $sth->fetchrow_array;
 | 
			
		||||
    }
 | 
			
		||||
    elsif (defined $id) {
 | 
			
		||||
        if ($id !~ /^\d+$/) {
 | 
			
		||||
            print $IN->header();
 | 
			
		||||
            print Links::SiteHTML::display('error', { error => Links::language('JUMP_INVALIDID', $id) });
 | 
			
		||||
            return;
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
# Find out if we're going to be displaying a file
 | 
			
		||||
        my $col = $IN->param('v') || $IN->param('dl') || $IN->param('view') || $IN->param('download');
 | 
			
		||||
 | 
			
		||||
        if ($col) {
 | 
			
		||||
# in this case, we need to know from what table we want to load our data from.
 | 
			
		||||
# It will by default pull information from the Links table, however if the
 | 
			
		||||
# DB=tablename option is used, it will apply the request to that table instead
 | 
			
		||||
            my $table_name = $IN->param('DB') || 'Links';
 | 
			
		||||
 | 
			
		||||
            unless ($table_name =~ m/^\w+$/) {
 | 
			
		||||
                print $IN->header();
 | 
			
		||||
                print Links::SiteHTML::display('error', { error => Links::language('FILE_TABLEFORMAT' ) });
 | 
			
		||||
                return;
 | 
			
		||||
            };
 | 
			
		||||
 | 
			
		||||
            if ($table_name ne 'Links') {
 | 
			
		||||
                eval { $links = $DB->table($table_name) };
 | 
			
		||||
                if ($@) {
 | 
			
		||||
                    print $IN->header();
 | 
			
		||||
                    print Links::SiteHTML::display('error', { error => Links::language('FILE_TABLE', $table_name, $GT::SQL::error) });
 | 
			
		||||
                    return;
 | 
			
		||||
                }
 | 
			
		||||
            }
 | 
			
		||||
 | 
			
		||||
            my $fh;
 | 
			
		||||
            eval { $fh = $links->file_info($col, $id); };
 | 
			
		||||
            if ($fh) {
 | 
			
		||||
                if ($IN->param('v') or $IN->param('view')) {    # Viewing
 | 
			
		||||
                    print $IN->header($IN->file_headers(
 | 
			
		||||
                        filename => $fh->File_Name,
 | 
			
		||||
                        mimetype => $fh->File_MimeType,
 | 
			
		||||
                        inline   => 1,
 | 
			
		||||
                        size     => $fh->File_Size
 | 
			
		||||
                    ));
 | 
			
		||||
                }
 | 
			
		||||
                else {                                          # Downloading
 | 
			
		||||
                    print $IN->header($IN->file_headers(
 | 
			
		||||
                        filename => $fh->File_Name,
 | 
			
		||||
                        mimetype => $fh->File_MimeType,
 | 
			
		||||
                        inline   => 0,
 | 
			
		||||
                        size     => $fh->File_Size
 | 
			
		||||
                    ));
 | 
			
		||||
                }
 | 
			
		||||
                binmode $fh;
 | 
			
		||||
                while (read($fh, my $buffer, 65536)) {
 | 
			
		||||
                    print $buffer;
 | 
			
		||||
                }
 | 
			
		||||
                return 1;
 | 
			
		||||
            }
 | 
			
		||||
            else {
 | 
			
		||||
                print $IN->header();
 | 
			
		||||
                print Links::SiteHTML::display('error', { error => Links::language('FILE_UNKNOWN', $id) });
 | 
			
		||||
                return;
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
# Jump to a URL, bump the hit counter.
 | 
			
		||||
        else {
 | 
			
		||||
            $rec = $links->select({ ID => $id }, VIEWABLE)->fetchrow_hashref;
 | 
			
		||||
            unless ($rec) {
 | 
			
		||||
                print $IN->header();
 | 
			
		||||
                print Links::SiteHTML::display('error', { error => Links::language('JUMP_INVALIDID', $id) });
 | 
			
		||||
                return;
 | 
			
		||||
            }
 | 
			
		||||
            $goto = $rec->{URL};
 | 
			
		||||
 | 
			
		||||
            my $clicktrack = $DB->table('ClickTrack');
 | 
			
		||||
            my $customdb = $DB->table('ClickTrack_Custom');
 | 
			
		||||
 | 
			
		||||
            my $rows = $clicktrack->count({ LinkID => $id, IP => $ENV{REMOTE_ADDR}, ClickType => 'Hits' });
 | 
			
		||||
            unless ($rows) {
 | 
			
		||||
                eval {
 | 
			
		||||
                    $clicktrack->insert({ LinkID => $id, IP => $ENV{REMOTE_ADDR}, ClickType => 'Hits', Created => \"NOW()" });
 | 
			
		||||
                    $customdb->insert({ click_linkid => $id, click_date => \"NOW()" });
 | 
			
		||||
                    $links->update({ Hits => \"Hits + 1", Timestmp => $rec->{Timestmp} }, { ID => $id }, { GT_SQL_SKIP_INDEX => 1 });
 | 
			
		||||
                };
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
# Oops, no link.
 | 
			
		||||
    else {
 | 
			
		||||
        print $IN->header();
 | 
			
		||||
        print Links::SiteHTML::display('error', { error => Links::language('JUMP_INVALIDID', $id) });
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
# Redirect to a detailed page if requested.
 | 
			
		||||
    if ($CFG->{build_detailed} and $IN->param('Detailed')) {
 | 
			
		||||
        $goto = Links::transform_url("$CFG->{build_detail_url}/" . $links->detailed_url($id));
 | 
			
		||||
    }
 | 
			
		||||
    ($goto =~ m,^\w+://,) or ($goto = "http://$goto");
 | 
			
		||||
 | 
			
		||||
    unless (defined $goto) {
 | 
			
		||||
        my $error = ($IN->param('ID') eq 'random') ? Links::language('RANDOM_NOLINKS') : Links::language('JUMP_INVALIDID', $id);
 | 
			
		||||
        print $IN->header();
 | 
			
		||||
        print Links::SiteHTML::display('error', { error => $error });
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    if ($goto) {
 | 
			
		||||
        if ($CFG->{framed_jump} and not ($CFG->{build_detailed} and $IN->param('Detailed'))) {
 | 
			
		||||
            unless (keys %$rec) {
 | 
			
		||||
                $rec = $links->select({ ID => $id }, VIEWABLE)->fetchrow_hashref;
 | 
			
		||||
            }
 | 
			
		||||
            $rec->{detailed_url} = "$CFG->{build_detail_url}/" . $links->detailed_url($id) if $CFG->{build_detailed};
 | 
			
		||||
            print $IN->header();
 | 
			
		||||
            print Links::SiteHTML::display('jump', { destination => $goto, %$rec });
 | 
			
		||||
            return;
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            print $IN->redirect($goto);
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        print $IN->header();
 | 
			
		||||
        print Links::SiteHTML::display('error', { error => Links::language('JUMP_INVALIDID', $id) });
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub generate_popular_links {
 | 
			
		||||
    my $mh = shift || 5;
 | 
			
		||||
    if ($GLinks::MOSTPOP) {
 | 
			
		||||
        return $GLinks::MOSTPOP;
 | 
			
		||||
    }
 | 
			
		||||
                     
 | 
			
		||||
    my $today = GT::Date::date_get();
 | 
			
		||||
    require Links::Plugins;
 | 
			
		||||
    my $cfg = Links::Plugins::get_plugin_user_cfg('MostPopular');
 | 
			
		||||
    my $last_x_days = $cfg->{last_x_days} || 14;
 | 
			
		||||
    my $from_date = GT::Date::date_sub($today, $last_x_days);
 | 
			
		||||
    my $to_date = GT::Date::date_sub($today, 0);
 | 
			
		||||
    require GT::SQL::Condition;
 | 
			
		||||
  #my $cond = GT::SQL::Condition->new('click_date', '>=', $from_date, 'click_date','<=', $to_date);
 | 
			
		||||
    my $cond = GT::SQL::Condition->new('Mod_Date', '>=', $from_date, 'Mod_Date','<=', $to_date);
 | 
			
		||||
  #my $db = $DB->table('ClickTrack_Custom');
 | 
			
		||||
	my $db = $DB->table('Links');
 | 
			
		||||
    my $linksdb = $DB->table('Links');
 | 
			
		||||
    use Data::Dumper;
 | 
			
		||||
    #$db->select_options('GROUP by click_linkid','ORDER BY count desc',"Limit $mh");	
 | 
			
		||||
	$db->select_options('ORDER BY Hits DESC',"Limit $mh");
 | 
			
		||||
  #my $sth = $db->select($cond, ['count(*) as count', 'click_linkid']);
 | 
			
		||||
    my $sth = $db->select($cond, ['ID']);
 | 
			
		||||
	my @loop;
 | 
			
		||||
    while (my $row = $sth->fetchrow_hashref()) {
 | 
			
		||||
        my $link = $linksdb->get($row->{ID});
 | 
			
		||||
        $link = Links::SiteHTML::tags('link',$link);
 | 
			
		||||
        push @loop, { %$link, %$row };
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    $GLinks::MOSTPOP = { MostPopularLinks => \@loop, FromDate => $from_date, ToDate => $to_date };
 | 
			
		||||
    return $GLinks::MOSTPOP;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
# Always end with a 1.
 | 
			
		||||
1;
 | 
			
		||||
@@ -0,0 +1,47 @@
 | 
			
		||||
# ==================================================================
 | 
			
		||||
# Plugins::NewestReviews - Auto Generated Program Module
 | 
			
		||||
#
 | 
			
		||||
#   Plugins::NewestReviews
 | 
			
		||||
#   Author  : Jordan Rapp
 | 
			
		||||
#   Version : 1.0
 | 
			
		||||
#   Updated : Wed Sep  11 20:07:11 2008
 | 
			
		||||
#
 | 
			
		||||
# ==================================================================
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package Plugins::NewestReviews;
 | 
			
		||||
# ==================================================================
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use GT::Base;
 | 
			
		||||
use GT::Plugins qw/STOP CONTINUE/;
 | 
			
		||||
use Links qw/:objects/;
 | 
			
		||||
 | 
			
		||||
# Inherit from base class for debug and error methods
 | 
			
		||||
@Plugins::NewestReviews::ISA = qw(GT::Base);
 | 
			
		||||
 | 
			
		||||
# Your code begins here.
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
# PLUGIN HOOKS
 | 
			
		||||
# ===================================================================
 | 
			
		||||
 | 
			
		||||
sub generate_newest_reviews {
 | 
			
		||||
    my $mh = shift || 5;
 | 
			
		||||
    require Links::Plugins;
 | 
			
		||||
    #my $cfg = Links::Plugins::get_plugin_user_cfg('MostPopular');
 | 
			
		||||
    my $db = $DB->table('Reviews');
 | 
			
		||||
    my $linksdb = $DB->table('Links');
 | 
			
		||||
    use Data::Dumper;
 | 
			
		||||
    my $sth = $db->do("SELECT Review_Subject, Review_LinkID FROM glinks_Reviews WHERE Review_Validated = 'Yes' ORDER BY Review_Date DESC LIMIT 5");
 | 
			
		||||
    my @loop;
 | 
			
		||||
    while (my $row = $sth->fetchrow_hashref()) {
 | 
			
		||||
        my $link = $linksdb->get($row->{Review_LinkID});
 | 
			
		||||
        $link = Links::SiteHTML::tags('link',$link);
 | 
			
		||||
        push @loop, { %$link, %$row };
 | 
			
		||||
    }
 | 
			
		||||
    return { NewestReviewsLinks => \@loop };
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
# Always end with a 1.
 | 
			
		||||
1;
 | 
			
		||||
@@ -0,0 +1,153 @@
 | 
			
		||||
# ==================================================================
 | 
			
		||||
# Plugins::OverrideModDate - Auto Generated Program Module
 | 
			
		||||
#
 | 
			
		||||
#   Plugins::OverrideModDate
 | 
			
		||||
#   Author  : Gossamer Threads Inc.
 | 
			
		||||
#   Version : 1.0
 | 
			
		||||
#   Updated : Mon Sep 24 14:34:23 2007
 | 
			
		||||
#
 | 
			
		||||
# ==================================================================
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package Plugins::OverrideModDate;
 | 
			
		||||
# ==================================================================
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use GT::Base;
 | 
			
		||||
use GT::Plugins qw/STOP CONTINUE/;
 | 
			
		||||
use Links qw/:objects/;
 | 
			
		||||
use Links::Build;
 | 
			
		||||
use Links::SiteHTML;
 | 
			
		||||
 | 
			
		||||
# Inherit from base class for debug and error methods
 | 
			
		||||
@Plugins::OverrideModDate::ISA = qw(GT::Base);
 | 
			
		||||
 | 
			
		||||
# Your code begins here.
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
# PLUGIN HOOKS
 | 
			
		||||
# ===================================================================
 | 
			
		||||
 | 
			
		||||
sub post_modify_link {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# Modify a single link.
 | 
			
		||||
#
 | 
			
		||||
    my $ret = shift;
 | 
			
		||||
    return $ret if (!$ret);
 | 
			
		||||
 | 
			
		||||
    my $new = {};
 | 
			
		||||
    my $update = 0;
 | 
			
		||||
    Links::init_date();
 | 
			
		||||
    if ($IN->param('Add_Date') =~ /^\d\d\d\d-\d\d-\d\d$/) {
 | 
			
		||||
        $new->{Add_Date} = $IN->param('Add_Date');
 | 
			
		||||
        $update = 1;
 | 
			
		||||
    }
 | 
			
		||||
    if ($IN->param('Mod_Date') =~ /^\d\d\d\d-\d\d-\d\d$/) {
 | 
			
		||||
        $new->{Mod_Date} = $IN->param('Mod_Date');
 | 
			
		||||
        $update = 1;
 | 
			
		||||
    }
 | 
			
		||||
    my $id = $IN->param('ID') || $IN->param('LinkID');
 | 
			
		||||
    if ($id and $update) {
 | 
			
		||||
        $DB->table('Links')->update({ %$new }, { ID => $id });
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return $ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub pre_handle {
 | 
			
		||||
# ---------------------------------------------------
 | 
			
		||||
# Determine what to do.
 | 
			
		||||
#
 | 
			
		||||
    my @args = @_;
 | 
			
		||||
    my $link_id = $IN->param('LinkID');
 | 
			
		||||
    if ($CFG->{user_required} and !$USER) {
 | 
			
		||||
        $PLG->action(STOP);
 | 
			
		||||
        print $IN->redirect(Links::redirect_login_url('modify'));
 | 
			
		||||
        return @args;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
# Perform the link modification
 | 
			
		||||
    if ($IN->param('modify')) {
 | 
			
		||||
        return @args;
 | 
			
		||||
    }
 | 
			
		||||
    elsif ($USER) {
 | 
			
		||||
# Display the link modify form (for a specific link)
 | 
			
		||||
        if ($IN->param('LinkID')) {
 | 
			
		||||
            $PLG->action(STOP);
 | 
			
		||||
            _modify_passed_in();
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    return @args;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _modify_passed_in {
 | 
			
		||||
# --------------------------------------------------------
 | 
			
		||||
# Display link that was passed in.
 | 
			
		||||
#
 | 
			
		||||
    my $lid = $IN->param('LinkID');
 | 
			
		||||
    my $link_db = $DB->table('Links');
 | 
			
		||||
    my $mtl = Links::Build::build('title', Links::language('LINKS_MODIFY'), "$CFG->{db_cgi_url}/modify.cgi?LinkID=$lid");
 | 
			
		||||
    my $sth = $link_db->select({ ID => $lid, LinkOwner => $USER->{Username} }, VIEWABLE);
 | 
			
		||||
    if ($USER->{Status} eq 'Administrator') {
 | 
			
		||||
        $sth = $link_db->select({ ID => $lid }, VIEWABLE);
 | 
			
		||||
    }
 | 
			
		||||
    if ($sth->rows) {
 | 
			
		||||
        my $link = $sth->fetchrow_hashref;
 | 
			
		||||
        my @ids = $DB->table('CatLinks')->select('CategoryID', { LinkID => $link->{ID} })->fetchall_list;
 | 
			
		||||
        $IN->param('CatLinks.CategoryID', \@ids);
 | 
			
		||||
 | 
			
		||||
        $link->{Contact_Name}  ||= $USER->{Name} || $USER->{Username};
 | 
			
		||||
        $link->{Contact_Email} ||= $USER->{Email};
 | 
			
		||||
 | 
			
		||||
        my $category = {};
 | 
			
		||||
        if ($CFG->{db_gen_category_list} < 2) {
 | 
			
		||||
            require Links::Tools;
 | 
			
		||||
            $category = Links::Tools::category_list();
 | 
			
		||||
            $category->{Category} = sub { Links::Tools::category_list_html() };
 | 
			
		||||
        }
 | 
			
		||||
        print $IN->header();
 | 
			
		||||
        print Links::SiteHTML::display('modify', {
 | 
			
		||||
            main_title_loop => $mtl,
 | 
			
		||||
            %$link,
 | 
			
		||||
            %$category
 | 
			
		||||
        });
 | 
			
		||||
    }
 | 
			
		||||
    elsif (!$CFG->{user_required}) {
 | 
			
		||||
        require Links::User::Modify;
 | 
			
		||||
        Links::User::Modify::_modify_form();
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        print $IN->header();
 | 
			
		||||
        print Links::SiteHTML::display('error', { error => Links::language('MODIFY_NOTOWNER'), LinkID => $lid, main_title_loop => $mtl });
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub post_add_link {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# Modify a single link.
 | 
			
		||||
#
 | 
			
		||||
    my $ret = shift;
 | 
			
		||||
    return $ret if (!$ret);
 | 
			
		||||
 | 
			
		||||
    my $new = {};
 | 
			
		||||
    my $update = 0;
 | 
			
		||||
    Links::init_date();
 | 
			
		||||
    if ($IN->param('Add_Date') =~ /^\d\d\d\d-\d\d-\d\d$/) {
 | 
			
		||||
        $new->{Add_Date} = $IN->param('Add_Date');
 | 
			
		||||
        $update = 1;
 | 
			
		||||
    }
 | 
			
		||||
    if ($IN->param('Mod_Date') =~ /^\d\d\d\d-\d\d-\d\d$/) {
 | 
			
		||||
        $new->{Mod_Date} = $IN->param('Mod_Date');
 | 
			
		||||
        $update = 1;
 | 
			
		||||
    }
 | 
			
		||||
    my $id = $ret->{ID};
 | 
			
		||||
    if ($id and $update) {
 | 
			
		||||
        $DB->table('Links')->update({ %$new }, { ID => $id });
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return $ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
# Always end with a 1.
 | 
			
		||||
1;
 | 
			
		||||
							
								
								
									
										1953
									
								
								site/slowtwitch.com/cgi-bin/articles/admin/Plugins/SlideShow.pm
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										1953
									
								
								site/slowtwitch.com/cgi-bin/articles/admin/Plugins/SlideShow.pm
									
									
									
									
									
										Normal file
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							@@ -0,0 +1,619 @@
 | 
			
		||||
# ==================================================================
 | 
			
		||||
# Plugins::SocialMedia - Auto Generated Program Module
 | 
			
		||||
#
 | 
			
		||||
#   Plugins::SocialMedia
 | 
			
		||||
#   Author  : Gossamer Threads Inc.
 | 
			
		||||
#   Version : 1.0
 | 
			
		||||
#   Updated : Tue Oct 29 11:32:05 2013
 | 
			
		||||
#
 | 
			
		||||
# ==================================================================
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package Plugins::SocialMedia;
 | 
			
		||||
# ==================================================================
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use GT::Base;
 | 
			
		||||
use GT::Plugins qw/STOP CONTINUE/;
 | 
			
		||||
use Links qw/:objects/;
 | 
			
		||||
use Links::Build;
 | 
			
		||||
use Links::SiteHTML;
 | 
			
		||||
use Net::Twitter;
 | 
			
		||||
use Links::Plugins;
 | 
			
		||||
use LWP::Simple;
 | 
			
		||||
use JSON;
 | 
			
		||||
use URI;
 | 
			
		||||
use utf8;
 | 
			
		||||
use vars  qw/$USE_HTML $TIME_START $TOTAL_TIME @CARP_NOT $GRAND_TOTAL/;
 | 
			
		||||
#use Scalar::Util 'blessed';
 | 
			
		||||
use GT::File::Tools qw/mkpath dirname/;
 | 
			
		||||
use Carp;
 | 
			
		||||
 | 
			
		||||
@CARP_NOT = 'GT::Plugins';
 | 
			
		||||
 | 
			
		||||
# Inherit from base class for debug and error methods
 | 
			
		||||
@Plugins::SocialMedia::ISA = qw(GT::Base);
 | 
			
		||||
 | 
			
		||||
# Your code begins here.
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
# PLUGIN HOOKS
 | 
			
		||||
# ===================================================================
 | 
			
		||||
 | 
			
		||||
sub post_twitter {
 | 
			
		||||
    my $link = shift;
 | 
			
		||||
    $link = format_link($link);
 | 
			
		||||
    $link || return;
 | 
			
		||||
 | 
			
		||||
# When no authentication is required:
 | 
			
		||||
    my $nt = Net::Twitter->new(legacy => 0);
 | 
			
		||||
 | 
			
		||||
    my $consumer_key = "u4xwsqHZBKrdWYPrKCm8Lw";
 | 
			
		||||
    my $consumer_secret = "vjDF6FjeoPJW0WVwgqMEJeuJzilgSIu5QbPGQnWrMI";
 | 
			
		||||
    my $token = "1921299666-fMicJMBunBjgBb4ieszHo6tYV0mQcbbaMZU5wSB";
 | 
			
		||||
    my $token_secret = "Ko9gPpBaLxqQj6u68EWdlgnPinGSseVzrzUvytWric";
 | 
			
		||||
 | 
			
		||||
#return { error => 'error posting...unknown' };
 | 
			
		||||
    my $tags = $IN->param('twitter_hash_tags');
 | 
			
		||||
    $tags =~ s/\s+//g;
 | 
			
		||||
    my @tags = split(',',$tags);
 | 
			
		||||
    my $newtags;
 | 
			
		||||
    for (@tags) {
 | 
			
		||||
        $newtags .= ' #' . $_;
 | 
			
		||||
    }
 | 
			
		||||
    my $post_title = $IN->param('twitter_status');
 | 
			
		||||
 | 
			
		||||
    my $len = length $link->{detailed_url};
 | 
			
		||||
    $len = 140 - 5 - $len;
 | 
			
		||||
    $post_title = substr($post_title,0,$len) . "..." if (length $post_title > $len);
 | 
			
		||||
    $post_title .= " " . $link->{detailed_url};
 | 
			
		||||
    $post_title .= $newtags;
 | 
			
		||||
 | 
			
		||||
# As of 13-Aug-2010, Twitter requires OAuth for authenticated requests
 | 
			
		||||
    $nt = Net::Twitter->new(
 | 
			
		||||
        traits   => [qw/API::RESTv1_1/],
 | 
			
		||||
        consumer_key        => $consumer_key,
 | 
			
		||||
        consumer_secret     => $consumer_secret,
 | 
			
		||||
        access_token        => $token,
 | 
			
		||||
        access_token_secret => $token_secret,
 | 
			
		||||
    );
 | 
			
		||||
 | 
			
		||||
    my $result;
 | 
			
		||||
    my $res = eval { $result = $nt->update($post_title) };
 | 
			
		||||
    if ( my $err = $@ ) {
 | 
			
		||||
        die $@ unless $err and $err->isa('Net::Twitter::Error');
 | 
			
		||||
        #warn "HTTP Response Code: ", $err->code, "\n",
 | 
			
		||||
        #"HTTP Message......: ", $err->message, "\n",
 | 
			
		||||
        #"Twitter error.....: ", $err->error, "\n";
 | 
			
		||||
        $result->{error} = $err->error;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return $result;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub post_facebook {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
    my $access_token = shift;
 | 
			
		||||
    my $id = shift; 
 | 
			
		||||
    my $link = format_link($id);
 | 
			
		||||
 | 
			
		||||
    if ($link->{facebook_hashtags}) {
 | 
			
		||||
        $link->{Description} .= " ";
 | 
			
		||||
        $link->{Description} .= $link->{facebook_hashtags};
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
#Publish to a facebook page as admin
 | 
			
		||||
    my $cfg = Links::Plugins::get_plugin_user_cfg('Auth_Facebook');
 | 
			
		||||
    my $result = facebook_graph_api('/' . $cfg->{fb_fanpageid} . '/links',{
 | 
			
		||||
        link => "http://www.slowtwitch.com/temp/$id.html",
 | 
			
		||||
        #link => $link->{detailed_url},
 | 
			
		||||
        message => $link->{Description},
 | 
			
		||||
        picture => $link->{Picture},
 | 
			
		||||
        access_token => $access_token,
 | 
			
		||||
        method => 'post'
 | 
			
		||||
    });
 | 
			
		||||
 | 
			
		||||
    return $result;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub facebook_graph_api {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
    my $uri = new URI('https://graph.facebook.com/' . shift);
 | 
			
		||||
    $uri->query_form(shift);
 | 
			
		||||
 | 
			
		||||
    require GT::WWW;
 | 
			
		||||
    my $www = GT::WWW->get("$uri");
 | 
			
		||||
    my $resp = $www->content;
 | 
			
		||||
    return defined $resp ? decode_json($resp) : undef;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub format_link {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
    my $link = shift;
 | 
			
		||||
    if ($link =~ /^(\d+)$/) {
 | 
			
		||||
        $link = $DB->table('Links')->get($link);
 | 
			
		||||
    }
 | 
			
		||||
    $link or return;
 | 
			
		||||
    $link = Links::SiteHTML::tags('link',$link);
 | 
			
		||||
 | 
			
		||||
    my $len = length $link->{detailed_url};
 | 
			
		||||
    $len = 140 - 5 - $len;
 | 
			
		||||
    $link->{Description} = substr($link->{Description},0,$len) . "..." if (length $link->{Description} > $len);
 | 
			
		||||
 | 
			
		||||
    my @cats = $DB->table('Category', 'CatLinks')->select('Category.Full_Name', { 'CatLinks.LinkID' => $link->{ID} })->fetchall_list;
 | 
			
		||||
    $link->{Category}      = join "\n", sort @cats;
 | 
			
		||||
 | 
			
		||||
    use Plugins::SlideShow;
 | 
			
		||||
    my $paths = Plugins::SlideShow::generate_paths($link->{ID});
 | 
			
		||||
    $link->{image_paths} = $paths;
 | 
			
		||||
    my $img = $link->{facebook_published_image} || "Image1";
 | 
			
		||||
    $link->{Picture} = $paths->{$img . '_largest_path'} if ($paths->{$img . '_largest_path'});
 | 
			
		||||
 | 
			
		||||
    return $link;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub publish_it {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
    if ($IN->param('build')) {
 | 
			
		||||
        my $linkid = $IN->param('linkid');
 | 
			
		||||
        my ($twitter, $fb); 
 | 
			
		||||
        use Time::HiRes;
 | 
			
		||||
        #Time::HiRes::sleep(5); #.1 seconds
 | 
			
		||||
        #print $IN->header;
 | 
			
		||||
        $IN->param('t','dev'); #FIXME
 | 
			
		||||
        #print $IN->header;
 | 
			
		||||
        build_it($linkid);
 | 
			
		||||
        my $hash = {};
 | 
			
		||||
 | 
			
		||||
        #print Links::user_page('add_success_publish.html', { success => '1', built => 1, twitter => $twitter, %$hash });
 | 
			
		||||
        #return;
 | 
			
		||||
 | 
			
		||||
        if ($IN->param('post_facebook')) {
 | 
			
		||||
            if ($IN->param('post_twitter')) {
 | 
			
		||||
                my $res = post_twitter($linkid);
 | 
			
		||||
                if ($res->{id}) {
 | 
			
		||||
                    $DB->table('Links')->update({ twitter_published => $res->{id} }, { ID => $linkid });
 | 
			
		||||
                    $hash->{twitter_published} = 1;
 | 
			
		||||
                }
 | 
			
		||||
                else {
 | 
			
		||||
                    $DB->table('Links')->update({ twitter_published_message => $res->{error} }, { ID => $linkid });
 | 
			
		||||
                    $hash->{twitter_published_message} = $res->{error} if ($res->{error});
 | 
			
		||||
                }
 | 
			
		||||
            }
 | 
			
		||||
            use Plugins::Auth_Facebook;
 | 
			
		||||
            Plugins::Auth_Facebook::user_auth($linkid);
 | 
			
		||||
            return;
 | 
			
		||||
        }
 | 
			
		||||
        elsif ($IN->param('post_twitter')) {
 | 
			
		||||
            my $res = post_twitter($linkid);
 | 
			
		||||
            if ($res->{id}) {
 | 
			
		||||
                $DB->table('Links')->update({ twitter_published => $res->{id} }, { ID => $linkid });
 | 
			
		||||
                $hash->{twitter_published} = 1;
 | 
			
		||||
            }
 | 
			
		||||
            else {
 | 
			
		||||
                $DB->table('Links')->update({ twitter_published_message => $res->{error} }, { ID => $linkid });
 | 
			
		||||
                $hash->{twitter_published_message} = $res->{error} if ($res->{error});
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
        $IN->param('t','dev'); #FIXME
 | 
			
		||||
        print $IN->header;
 | 
			
		||||
        print Links::user_page('add_success_publish.html', { success => '1', built => 1, twitter => $twitter, %$hash });
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        print $IN->header;
 | 
			
		||||
        print Links::user_page('error.html', { error => 'no error' });
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub build_it {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
#
 | 
			
		||||
    my $linkid = shift || return;
 | 
			
		||||
    my $unix_time = $CFG->{last_build} ? $CFG->{last_build} : time;
 | 
			
		||||
    Links::init_date();
 | 
			
		||||
    my $time = GT::Date::date_get($unix_time - $CFG->{date_offset} * 3600, '%yyyy%-%mm%-%dd% %HH%:%MM%:%ss%');
 | 
			
		||||
 | 
			
		||||
=tag
 | 
			
		||||
# Do any backups.
 | 
			
		||||
    _build_backup();
 | 
			
		||||
 | 
			
		||||
# Update isNew, isCool, isPopular flags.
 | 
			
		||||
    _build_reset_hits();
 | 
			
		||||
    _build_new_flags();
 | 
			
		||||
    _build_changed_flags();
 | 
			
		||||
    _build_cool_flags();
 | 
			
		||||
 | 
			
		||||
# Build Home Page.
 | 
			
		||||
    $PLG->dispatch('create_home', \&_build_home, {});
 | 
			
		||||
=cut
 | 
			
		||||
 | 
			
		||||
=tag
 | 
			
		||||
# Build New Page.
 | 
			
		||||
    $PLG->dispatch('create_new', \&_build_new, {});
 | 
			
		||||
 | 
			
		||||
# Build Cool Page.
 | 
			
		||||
    $PLG->dispatch('create_cool', \&_build_cool, {});
 | 
			
		||||
 | 
			
		||||
# Build Ratings Page.
 | 
			
		||||
    $PLG->dispatch('create_ratings', \&_build_ratings, {});
 | 
			
		||||
=cut
 | 
			
		||||
 | 
			
		||||
# Build Changed Detailed Page.
 | 
			
		||||
    $PLG->dispatch('create_detailed_changed', \&_build_detailed, GT::SQL::Condition->new('Links.ID', '=', $linkid));
 | 
			
		||||
 | 
			
		||||
=tag
 | 
			
		||||
# Build Changed Category Pages.
 | 
			
		||||
    $PLG->dispatch('create_category_changed', \&_build_category, GT::SQL::Condition->new('Timestmp', '>', $time));
 | 
			
		||||
 | 
			
		||||
    $CFG->{last_build} = time;
 | 
			
		||||
    $CFG->save;
 | 
			
		||||
=cut
 | 
			
		||||
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub get_path {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
#
 | 
			
		||||
    my $field = shift;
 | 
			
		||||
    my $filefield = $field . "_largest_path";
 | 
			
		||||
    my $link = GT::Template->tags();
 | 
			
		||||
    if (!$link->{$filefield}) {
 | 
			
		||||
        $filefield = $field . "_medium_path";
 | 
			
		||||
    }
 | 
			
		||||
    return $link->{$filefield};
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# MISC BUILD functions
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
sub _build_home {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Generate the home page.
 | 
			
		||||
#
 | 
			
		||||
    _time_start();
 | 
			
		||||
 | 
			
		||||
    my $index = $CFG->{build_home} || $CFG->{build_index};
 | 
			
		||||
    my $page = "$CFG->{build_root_path}/$index";
 | 
			
		||||
    print $USE_HTML
 | 
			
		||||
        ? qq'Building <a href="$CFG->{build_root_url}/$index" target="_blank">Home Page</a>...\n'
 | 
			
		||||
        : qq'Building Home Page...\n';
 | 
			
		||||
 | 
			
		||||
    my $fh = _open_write($page);
 | 
			
		||||
    print $fh Links::Build::build(home => {});
 | 
			
		||||
    close $fh;
 | 
			
		||||
    my $perms = oct $CFG->{build_file_per};
 | 
			
		||||
    chmod $perms, $page;
 | 
			
		||||
 | 
			
		||||
    _display_time();
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _build_detailed {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Generate one html page per link.
 | 
			
		||||
#
 | 
			
		||||
    require Links::Tools;
 | 
			
		||||
 | 
			
		||||
    my ($cond, $cust_page, $cust_limit);
 | 
			
		||||
    if (ref $_[0] eq 'HASH') {
 | 
			
		||||
        $cust_page = $_[0]->{page};
 | 
			
		||||
        $cust_limit = $_[0]->{limit};
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        $cond = shift;
 | 
			
		||||
    }
 | 
			
		||||
    unless ($CFG->{build_detailed}) {
 | 
			
		||||
        print "Skipping Detailed Build (disabled).\n\n";
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    _time_start();
 | 
			
		||||
 | 
			
		||||
    #print "Building Detailed pages...\n";
 | 
			
		||||
 | 
			
		||||
# Only build validated links
 | 
			
		||||
    $cond ||= GT::SQL::Condition->new;
 | 
			
		||||
    $cond->add(VIEWABLE);
 | 
			
		||||
 | 
			
		||||
# Loop through, building 1000 at a time
 | 
			
		||||
    my ($limit, $offset, $count, $second_pass) = (1000, 0, 0);
 | 
			
		||||
    my $rel = $DB->table(qw/Links CatLinks Category/);
 | 
			
		||||
    #print "\t";
 | 
			
		||||
 | 
			
		||||
    my $Links = $DB->table('Links');
 | 
			
		||||
    while () {
 | 
			
		||||
# Links can be in multiple categories, make sure their detailed pages are only built once
 | 
			
		||||
        $rel->select_options("GROUP BY LinkID") if $CFG->{build_detail_format} eq '%ID%';
 | 
			
		||||
        $rel->select_options("ORDER BY LinkID");
 | 
			
		||||
 | 
			
		||||
        if ($cust_page or $cust_limit) {
 | 
			
		||||
            last if $second_pass++;
 | 
			
		||||
            $rel->select_options(sprintf "LIMIT %d OFFSET %d", $cust_limit, ($cust_page-1) * $cust_limit);
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            $rel->select_options(sprintf "LIMIT %d OFFSET %d", $limit, $offset*$limit);
 | 
			
		||||
        }
 | 
			
		||||
        my %links_cols = %{$Links->cols};
 | 
			
		||||
        # Only select Category columns that don't conflict with Links columns.
 | 
			
		||||
        my @cat_cols = grep !$links_cols{$_}, keys %{$DB->table('Category')->cols};
 | 
			
		||||
 | 
			
		||||
        my $sth = $rel->select('Links.*', @cat_cols, 'CategoryID' => $cond);
 | 
			
		||||
 | 
			
		||||
        last unless $sth->rows;
 | 
			
		||||
 | 
			
		||||
        while (my $link = $sth->fetchrow_hashref) {
 | 
			
		||||
            my $format = $Links->detailed_url($link);
 | 
			
		||||
            $format = "temp/" . $link->{ID} . ".html"; #FIXME
 | 
			
		||||
            my $page = "$CFG->{build_detail_path}/$format";
 | 
			
		||||
            my $url  = "$CFG->{build_detail_url}/$format";
 | 
			
		||||
 | 
			
		||||
            {
 | 
			
		||||
                my $fh = _open_write($page);
 | 
			
		||||
                print $fh Links::Build::build(detailed => $link);
 | 
			
		||||
            }
 | 
			
		||||
            my $perms = oct $CFG->{build_file_per};
 | 
			
		||||
            chmod $perms, $page;
 | 
			
		||||
 | 
			
		||||
=tag
 | 
			
		||||
            $USE_HTML ?
 | 
			
		||||
                print qq'<a href="$url" target="_blank">$link->{ID}</a> ' :
 | 
			
		||||
                print "$link->{ID} ";
 | 
			
		||||
            print "\n\t" if ++$count % 20 == 0;
 | 
			
		||||
=cut
 | 
			
		||||
        }
 | 
			
		||||
        $offset++;
 | 
			
		||||
    }
 | 
			
		||||
=tag
 | 
			
		||||
    print "\n";
 | 
			
		||||
    _display_time();
 | 
			
		||||
=cut
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _build_category {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Generate the category pages.
 | 
			
		||||
#
 | 
			
		||||
    my ($cond, $cust_page, $cust_limit);
 | 
			
		||||
    if (ref $_[0] eq 'HASH') {
 | 
			
		||||
        $cust_page  = $_[0]->{page};
 | 
			
		||||
        $cust_limit = $_[0]->{offset};
 | 
			
		||||
        $cond = {};
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        $cond = shift;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    _time_start();
 | 
			
		||||
 | 
			
		||||
    print "Building Category pages...\n\n";
 | 
			
		||||
 | 
			
		||||
    my $Cat = $DB->table('Category');
 | 
			
		||||
    my $CatLinks = $DB->table('Links', 'CatLinks');
 | 
			
		||||
 | 
			
		||||
    $Cat->select_options('ORDER BY Full_Name');
 | 
			
		||||
    if (defined $cust_page and $cust_limit) {
 | 
			
		||||
        $Cat->select_options(sprintf "LIMIT %d OFFSET %d", $cust_limit, ($cust_page-1)*$cust_limit);
 | 
			
		||||
    }
 | 
			
		||||
    my $sth = $Cat->select(ID => Full_Name => $cond);
 | 
			
		||||
    while (my ($id, $name) = $sth->fetchrow_array) {
 | 
			
		||||
        my $clean_name = $Cat->as_url($name);
 | 
			
		||||
        my $page = $CFG->{build_root_path} . "/" . $clean_name . '/' . $CFG->{build_index};
 | 
			
		||||
        my $url  = $CFG->{build_root_url}  . "/" . $clean_name . '/' . $CFG->{build_index};
 | 
			
		||||
        print $USE_HTML
 | 
			
		||||
            ? "\tBuilding category <a href='$url' target='_blank'>$name</a>...\n"
 | 
			
		||||
            : "\tBuilding category $name...\n";
 | 
			
		||||
        my $total = $CatLinks->count({ 'CatLinks.CategoryID' => $id }, VIEWABLE);
 | 
			
		||||
        print "\t\tLinks: $total\n";
 | 
			
		||||
 | 
			
		||||
# Do sub-pages if requested.
 | 
			
		||||
        if ($CFG->{build_span_pages}) {
 | 
			
		||||
            my $lpp       = $CFG->{build_links_per_page} || 25;
 | 
			
		||||
            my $num_pages = int($total / $lpp);
 | 
			
		||||
            $num_pages++ if $total % $lpp;
 | 
			
		||||
 | 
			
		||||
# Create the main page.
 | 
			
		||||
            {
 | 
			
		||||
                my $fh = _open_write($page);
 | 
			
		||||
                print $fh Links::Build::build(category => { id => $id,  nh => 1, mh => $lpp });
 | 
			
		||||
            }
 | 
			
		||||
            my $perms = oct $CFG->{build_file_per};
 | 
			
		||||
            chmod $perms, $page;
 | 
			
		||||
 | 
			
		||||
# Create the sub pages.
 | 
			
		||||
            for (2 .. $num_pages) {
 | 
			
		||||
                $page = "$CFG->{build_root_path}/$clean_name/$CFG->{build_more}$_$CFG->{build_extension}";
 | 
			
		||||
                $url  = "$CFG->{build_root_url}/$clean_name/$CFG->{build_more}$_$CFG->{build_extension}";
 | 
			
		||||
                print "\t\tBuilding subpage: " . ($USE_HTML
 | 
			
		||||
                    ? "<a href='$url' target='_blank'>$_</a>\n"
 | 
			
		||||
                    : "$_\n"
 | 
			
		||||
                );
 | 
			
		||||
                {
 | 
			
		||||
                    my $fh = _open_write($page);
 | 
			
		||||
                    print $fh Links::Build::build(category => { id => $id, nh => $_, mh => $lpp });
 | 
			
		||||
                }
 | 
			
		||||
                chmod $perms, $page;
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            {
 | 
			
		||||
                my $fh = _open_write($page);
 | 
			
		||||
                print $fh Links::Build::build(category => { id => $id });
 | 
			
		||||
            }
 | 
			
		||||
            my $perms = oct $CFG->{build_file_per};
 | 
			
		||||
            chmod $perms, $page;
 | 
			
		||||
        }
 | 
			
		||||
        print "\tDone\n\n";
 | 
			
		||||
    }
 | 
			
		||||
    _display_time("Finished building categories");
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _build_backup {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Create a backup file in our backup directory.
 | 
			
		||||
#
 | 
			
		||||
    if (! $CFG->{build_use_backup}) {
 | 
			
		||||
        print "Creating backup file... skipped\n\n";
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
    _time_start();
 | 
			
		||||
    print "Creating backup file...\n";
 | 
			
		||||
    require Links::Import::S2BK;
 | 
			
		||||
 | 
			
		||||
    my $max_keep = 7;
 | 
			
		||||
    my $root     = $CFG->{admin_root_path} . '/backup';
 | 
			
		||||
    my $filename = 'BACKUP';
 | 
			
		||||
 | 
			
		||||
    for my $n (reverse 0 .. $max_keep) {
 | 
			
		||||
        my $oldname = join '.', $filename, $n || ();
 | 
			
		||||
        my $newname = join '.', $filename, $n+1;
 | 
			
		||||
        if (-e "$root/$oldname") {
 | 
			
		||||
            rename "$root/$oldname", "$root/$newname" or print "\tCouldn't rename '$root/$oldname' -> '$root/$newname': $!";
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    Links::Import::S2BK::import({ source => "$CFG->{admin_root_path}/defs", destination => "$root/$filename", delimiter => "\t" }, sub { print "\n\tWARNING: @_\n" }, sub { die @_ }, sub { print "\n\tWARNING: @_\n" }, sub { });
 | 
			
		||||
    _display_time();
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _build_reset_hits {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Updates the What's New flags.
 | 
			
		||||
#
 | 
			
		||||
    _time_start();
 | 
			
		||||
    print "Resetting hits and rates...\n";
 | 
			
		||||
    my $ret = Links::Build::build(reset_hits => shift || {});
 | 
			
		||||
    _display_time();
 | 
			
		||||
    return $ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _build_new_flags {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Updates the What's New flags.
 | 
			
		||||
#
 | 
			
		||||
    _time_start();
 | 
			
		||||
    print "Updating new flags...\n";
 | 
			
		||||
    my $ret = Links::Build::build(new_flags => shift || {});
 | 
			
		||||
    _display_time();
 | 
			
		||||
    return $ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _build_changed_flags {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Updates the isChanged flags.
 | 
			
		||||
#
 | 
			
		||||
    _time_start();
 | 
			
		||||
    print "Updating changed flags...\n";
 | 
			
		||||
    my $ret = Links::Build::build(changed_flags => shift || {});
 | 
			
		||||
    _display_time();
 | 
			
		||||
    return $ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _build_cool_flags {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Updates the What's Cool flags.
 | 
			
		||||
#
 | 
			
		||||
    _time_start();
 | 
			
		||||
    print "Updating Cool Flags...\n";
 | 
			
		||||
    my $ret = Links::Build::build(cool_flags => shift || {});
 | 
			
		||||
    _display_time();
 | 
			
		||||
    return $ret;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _time_start {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Start a timer.
 | 
			
		||||
#    
 | 
			
		||||
    $TIME_START = time;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _display_time {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Return time results.
 | 
			
		||||
#
 | 
			
		||||
    my $message = shift || 'Done';
 | 
			
		||||
    return;
 | 
			
		||||
    printf "%s (%.2fs)\n\n", $message, time - $TIME_START;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _header {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Print intro.
 | 
			
		||||
#
 | 
			
		||||
    my ($msg, $msg2, $refresh, $started) = @_;
 | 
			
		||||
    my $time    = scalar localtime;
 | 
			
		||||
 | 
			
		||||
    $refresh ||= '';
 | 
			
		||||
    $TOTAL_TIME = $started || time;
 | 
			
		||||
    $refresh  &&= "<meta http-equiv='Refresh' content='2; URL=$refresh'>";
 | 
			
		||||
    if ($USE_HTML) {
 | 
			
		||||
        print $IN->header(-nph => $CFG->{nph_headers});
 | 
			
		||||
        print <<BUILDING;
 | 
			
		||||
<html>
 | 
			
		||||
<head>
 | 
			
		||||
$refresh
 | 
			
		||||
<title>Building HTML Pages</title>
 | 
			
		||||
<body bgcolor="white">
 | 
			
		||||
BUILDING
 | 
			
		||||
        print Links::header("Building HTML Pages: $msg", $msg2, 0);
 | 
			
		||||
        print <<STARTED;
 | 
			
		||||
<pre>Started at $time.
 | 
			
		||||
 | 
			
		||||
STARTED
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        print "Started at $time.\n\nBuilding HTML pages...\n\n";
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _footer {
 | 
			
		||||
# ------------------------------------------------------------------
 | 
			
		||||
# Print the footer.
 | 
			
		||||
#
 | 
			
		||||
    my $end = time;
 | 
			
		||||
    my $elapsed = sprintf "%.2f", $end - $TOTAL_TIME;
 | 
			
		||||
 | 
			
		||||
    print "All done. Total time: (${elapsed}s)\n";
 | 
			
		||||
    print "</pre></body></html>" if $USE_HTML;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub _open_write {
 | 
			
		||||
# -----------------------------------------------------------------------------
 | 
			
		||||
# Opens a file for writing (overwriting anything already there), and returns a
 | 
			
		||||
# filehandle reference.  Dies with a more user-friendly error then Links::fatal
 | 
			
		||||
# if the open fails.  Can take a second argument which, if true, will cause the
 | 
			
		||||
# function _not_ to attempt to make the containing directory.
 | 
			
		||||
#
 | 
			
		||||
    my ($page, $nomkdir) = @_;
 | 
			
		||||
    unless ($nomkdir) {
 | 
			
		||||
        mkpath(dirname($page), oct $CFG->{build_dir_per});
 | 
			
		||||
    }
 | 
			
		||||
    my $fh = \do { local *FH; *FH };
 | 
			
		||||
    open $fh, "> $page" and return $fh;
 | 
			
		||||
 | 
			
		||||
    my $error = "$!";
 | 
			
		||||
    my $user = eval { getpwuid($>) } || 'webserver';
 | 
			
		||||
    if ($error =~ /permission/i) {
 | 
			
		||||
        print "\n\n<b>ERROR:</b> Unable to open '$page': $error\n\n";
 | 
			
		||||
        if (-e $page) {
 | 
			
		||||
            print <<HELP;
 | 
			
		||||
This means that the user '$user' is not able to overwrite the existing file.
 | 
			
		||||
Please make sure you have set the permissions in the setup to 0666 if you plan
 | 
			
		||||
to build from both the web and shell at the same time.
 | 
			
		||||
 | 
			
		||||
HELP
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            print <<HELP;
 | 
			
		||||
This means that the user '$user' is not able to create a file in your pages
 | 
			
		||||
directory. Please chmod the main directory 0777 so the program can create the
 | 
			
		||||
file.
 | 
			
		||||
 | 
			
		||||
HELP
 | 
			
		||||
        }
 | 
			
		||||
        croak "Debug information";
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        croak "Unable to open: '$page': $error";
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
1;
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										703
									
								
								site/slowtwitch.com/cgi-bin/articles/admin/Plugins/UI.pm
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										703
									
								
								site/slowtwitch.com/cgi-bin/articles/admin/Plugins/UI.pm
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,703 @@
 | 
			
		||||
# ==================================================================
 | 
			
		||||
# Plugins::UI - Auto Generated Program Module
 | 
			
		||||
#
 | 
			
		||||
#   Plugins::UI
 | 
			
		||||
#   Author  : Bao Phan
 | 
			
		||||
#   Version : 1.0
 | 
			
		||||
#   Updated : Tue Mar 15 12:59:20 2016
 | 
			
		||||
#
 | 
			
		||||
# ==================================================================
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package Plugins::UI;
 | 
			
		||||
# ==================================================================
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use GT::Base;
 | 
			
		||||
use GT::Plugins qw/STOP CONTINUE/;
 | 
			
		||||
use Links qw/:objects :payment/;
 | 
			
		||||
use Links::Build;
 | 
			
		||||
use Links::SiteHTML;
 | 
			
		||||
 | 
			
		||||
use constants
 | 
			
		||||
  VIDEO   => 'video',
 | 
			
		||||
  PHOTO   => 'photo',
 | 
			
		||||
  ARTICLE => 'article'
 | 
			
		||||
;
 | 
			
		||||
# Inherit from base class for debug and error methods
 | 
			
		||||
@Plugins::UI::ISA = qw(GT::Base);
 | 
			
		||||
 | 
			
		||||
require Plugins::SlideShow;
 | 
			
		||||
require Plugins::ConvertVideo;
 | 
			
		||||
require GT::SQL::Condition;
 | 
			
		||||
require GT::Date;
 | 
			
		||||
 | 
			
		||||
sub cat_url {
 | 
			
		||||
    my $full_name = shift || return;
 | 
			
		||||
 | 
			
		||||
    return "$CFG->{build_root_url}/" . $DB->table('Category')->as_url($full_name) . "/" . ($CFG->{build_index_include} ? $CFG->{build_index} : '');
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub update_featured_links {
 | 
			
		||||
    my ($type, $id, $add) = @_;
 | 
			
		||||
 | 
			
		||||
    return if $USER->{Status} ne 'Administrator';
 | 
			
		||||
 | 
			
		||||
    return unless $id and $type;
 | 
			
		||||
    return if $type !~ /^(article|photo|video)$/i;
 | 
			
		||||
 | 
			
		||||
    my $name = $type eq 'article' ? 'featured_articles' : 'featured_photos';
 | 
			
		||||
    my $ids  = $CFG->{$name} || [];
 | 
			
		||||
 | 
			
		||||
    my (@ids, $changed);
 | 
			
		||||
    my %ids = map { $_ => 1 } @$ids;
 | 
			
		||||
    if ($add) {
 | 
			
		||||
        if ($ids{$id}) {
 | 
			
		||||
            @ids = @$ids;
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            @ids = ($id, @$ids);
 | 
			
		||||
        
 | 
			
		||||
            my $hits = scalar @ids;
 | 
			
		||||
            if ($type eq 'article' and $hits > 4) {
 | 
			
		||||
                pop @ids;
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($type ne 'article' and $hits > 2) {
 | 
			
		||||
                pop @ids;
 | 
			
		||||
            }
 | 
			
		||||
            $changed = 1;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    elsif ($ids{$id}) {
 | 
			
		||||
        @ids = map $_, grep { $_ != $id } @$ids;
 | 
			
		||||
        $changed = 1;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return unless $changed;
 | 
			
		||||
    
 | 
			
		||||
    $CFG->{$name} = \@ids;
 | 
			
		||||
    $CFG->save;
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub is_featured {
 | 
			
		||||
    my ($type, $id) = @_;
 | 
			
		||||
    
 | 
			
		||||
    return unless $id and $type;
 | 
			
		||||
    return if $type !~ /^(article|photo|video)$/i;
 | 
			
		||||
    
 | 
			
		||||
    my $name = $type eq 'article' ? 'featured_articles' : 'featured_photos';
 | 
			
		||||
    my $ids  = $CFG->{$name} || [];
 | 
			
		||||
    my %ids  = map { $_ => 1 } @$ids;
 | 
			
		||||
    return $ids{$id} ? 1 : 0;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub fetch_categories {
 | 
			
		||||
    my $ids = shift;
 | 
			
		||||
 | 
			
		||||
    $ids = ref $ids ? @$ids : [$ids] if $ids;
 | 
			
		||||
 | 
			
		||||
    my $tab = $DB->table('Category');
 | 
			
		||||
    $tab->select_options('ORDER BY Name');
 | 
			
		||||
    my $cond = GT::SQL::Condition->new( CatDepth => '=' => 0);
 | 
			
		||||
    $cond->add(ID => '=' => $ids) if $ids;
 | 
			
		||||
 | 
			
		||||
    my $cats = $tab->select($cond)->fetchall_hashref;
 | 
			
		||||
    foreach (@$cats) {
 | 
			
		||||
        $_->{URL} = "$CFG->{build_root_url}/" . $tab->as_url($_->{Full_Name}) . "/" . ($CFG->{build_index_include} ? $CFG->{build_index} : '');
 | 
			
		||||
    }
 | 
			
		||||
    return $cats;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub fetch_links {
 | 
			
		||||
    my %args = @_;
 | 
			
		||||
 | 
			
		||||
    return unless %args;
 | 
			
		||||
 | 
			
		||||
    my $maxhits = $args{max_hits} || 1;
 | 
			
		||||
    my $cond    = new GT::SQL::Condition;
 | 
			
		||||
    my $url     = $CFG->{build_detail_url};
 | 
			
		||||
    my (@ids, %paging);
 | 
			
		||||
 | 
			
		||||
    my $tab_cat  = $DB->table('Category');
 | 
			
		||||
    my $tab_lnks = $DB->table('Links');
 | 
			
		||||
    my $tab_catlnks = $DB->table(qw/Links CatLinks Category/);
 | 
			
		||||
    if ($args{type}) {
 | 
			
		||||
        $cond->add(Type => '=' => $args{type});
 | 
			
		||||
        $tab_catlnks->select_options("GROUP BY LinkID", "ORDER BY Add_Date DESC", "LIMIT $maxhits");
 | 
			
		||||
    }
 | 
			
		||||
    elsif ($args{ids}) {
 | 
			
		||||
        if (ref $args{ids} eq 'ARRAY') {
 | 
			
		||||
            @ids = @{$args{ids}};
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            @ids = split(/\,|\r?\n/, $args{ids});
 | 
			
		||||
        }
 | 
			
		||||
        return unless scalar @ids;
 | 
			
		||||
 | 
			
		||||
        $cond->add(LinkID => '=' => \@ids);
 | 
			
		||||
        $tab_catlnks->select_options("ORDER BY Add_Date DESC");
 | 
			
		||||
        $tab_catlnks->select_options("LIMIT $maxhits") if $args{max_hits};
 | 
			
		||||
    }
 | 
			
		||||
    elsif ($args{category}) {
 | 
			
		||||
        my $category = $tab_cat->get($args{category});
 | 
			
		||||
        return unless $category;
 | 
			
		||||
 | 
			
		||||
        $cond->add(Full_Name => 'like' => $category->{Full_Name} . '%');
 | 
			
		||||
        $tab_catlnks->select_options("ORDER BY Add_Date DESC", "LIMIT $maxhits");
 | 
			
		||||
    }
 | 
			
		||||
    elsif ($args{tag} and $args{tag} =~ /^(?:swim|bike|run)$/i) {
 | 
			
		||||
        my $vars = GT::Template->vars;
 | 
			
		||||
        my $tag  = lc $args{tag};
 | 
			
		||||
        $url    .= "/$tag";
 | 
			
		||||
 | 
			
		||||
        $paging{max_hits}     = $args{max_hits} || 25;
 | 
			
		||||
        $paging{current_page} = $vars->{nh} || 1;
 | 
			
		||||
        $paging{page}         = $args{url} || ($tag . '/');
 | 
			
		||||
 | 
			
		||||
        my $offset = $paging{current_page} == 1 ? 0 : ($paging{current_page} - 1) * $paging{max_hits};
 | 
			
		||||
 | 
			
		||||
        $cond->add('tag_' . $tag => '=' => 1);
 | 
			
		||||
        $tab_catlnks->select_options("GROUP BY LinkID", "ORDER BY Add_Date DESC", "LIMIT $paging{max_hits} OFFSET $offset");
 | 
			
		||||
    }
 | 
			
		||||
    elsif ($args{link_type} and $args{link_type} =~ /^(?:photo|video)$/i) {
 | 
			
		||||
        my $vars = GT::Template->vars;
 | 
			
		||||
        $url    .= "/" . ($args{link_type} eq 'video' ? 'Videos' : 'Photos');
 | 
			
		||||
 | 
			
		||||
        $paging{max_hits}     = $args{max_hits} || 25;
 | 
			
		||||
        $paging{current_page} = $vars->{nh} || 1;
 | 
			
		||||
        $paging{page}         = ($args{link_type} eq 'video' ? 'Videos' : 'Photos') . '/';
 | 
			
		||||
 | 
			
		||||
        my $offset = $paging{current_page} == 1 ? 0 : ($paging{current_page} - 1) * $paging{max_hits};
 | 
			
		||||
 | 
			
		||||
        $cond->add(Link_Type => '=' => $args{link_type});
 | 
			
		||||
        $tab_catlnks->select_options("GROUP BY LinkID", "ORDER BY Add_Date DESC", "LIMIT $paging{max_hits} OFFSET $offset");
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        $tab_catlnks->select_options("GROUP BY LinkID", "ORDER BY Add_Date DESC", "LIMIT $maxhits");
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    my $links = ($tab_catlnks->select(qw/Links.* Name Full_Name/, $cond) or die $GT::SQL::error)->fetchall_hashref;
 | 
			
		||||
    return unless scalar @$links;
 | 
			
		||||
 | 
			
		||||
    foreach my $l (@$links) {
 | 
			
		||||
        $l->{detailed_url}  = "$url/" . $tab_lnks->detailed_url($l->{ID}) if $CFG->{build_detailed}; 
 | 
			
		||||
        $l->{URL}           = "$CFG->{build_root_url}/" . $tab_cat->as_url($l->{Full_Name}) . "/" . ($CFG->{build_index_include} ? $CFG->{build_index} : '');
 | 
			
		||||
        $l->{thumbnail_url} = fetch_thumbnail($l);
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    if (scalar @ids and !$args{db}) {
 | 
			
		||||
        my @links_output;
 | 
			
		||||
        my %links = map { $_->{ID} => $_ } @$links;
 | 
			
		||||
 | 
			
		||||
        foreach my $id (@ids) {
 | 
			
		||||
            push @links_output, $links{$id} if $links{$id};
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        return \@links_output;
 | 
			
		||||
    }
 | 
			
		||||
    elsif (
 | 
			
		||||
        ($args{link_type} and $args{link_type} =~ /^(?:photo|video)$/) or 
 | 
			
		||||
        ($args{tag} and $args{tag} =~ /^(?:swim|bike|run)$/) 
 | 
			
		||||
    ) {
 | 
			
		||||
        $paging{num_hits} = $tab_lnks->select('COUNT(*)', $cond)->fetchrow;
 | 
			
		||||
 | 
			
		||||
        my @features;
 | 
			
		||||
        if ($paging{current_page} == 1) {
 | 
			
		||||
            @features = splice @$links, 0, 3;
 | 
			
		||||
        }
 | 
			
		||||
        return { loop => $links, features => \@features, paging => \%paging };
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        return $links;
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub fetch_category {
 | 
			
		||||
    my $catid = shift || return;
 | 
			
		||||
    return $DB->table('Category')->get($catid);
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub fetch_widget {
 | 
			
		||||
    my $id = shift || return;
 | 
			
		||||
 | 
			
		||||
    my $tab = $DB->table('Widgets');
 | 
			
		||||
    my $widget = $tab->get($id);
 | 
			
		||||
 | 
			
		||||
    return unless $widget;
 | 
			
		||||
 | 
			
		||||
    if ($widget->{Image}) {
 | 
			
		||||
        my $fh = $tab->file_info('Image', $widget->{ID});
 | 
			
		||||
        $widget->{Image_URL} = '/images/widgets/' . $fh->File_RelativeURL;
 | 
			
		||||
    }
 | 
			
		||||
    return $widget;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub fetch_widgets {
 | 
			
		||||
    my ($page, $catid) = @_;
 | 
			
		||||
    
 | 
			
		||||
    return unless $page;
 | 
			
		||||
 | 
			
		||||
    my $tab_pgwidgets = $DB->table(qw/Widgets PageWidgets/);
 | 
			
		||||
    $tab_pgwidgets->select_options('ORDER BY Sort_Pos');
 | 
			
		||||
 | 
			
		||||
    my $widgets = [];
 | 
			
		||||
    if ($catid =~ /^\d+$/) {
 | 
			
		||||
        $widgets = $tab_pgwidgets->select(qw/Widgets.* Sort_Pos/, { Page => $catid })->fetchall_hashref;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    unless (scalar @$widgets) {
 | 
			
		||||
        $widgets = $tab_pgwidgets->select(qw/Widgets.* Sort_Pos/, { Page => $page })->fetchall_hashref;
 | 
			
		||||
    }
 | 
			
		||||
    my $tab = $DB->table('Widgets');
 | 
			
		||||
    foreach my $w (@$widgets) {
 | 
			
		||||
        next unless $w->{Image};
 | 
			
		||||
        my $fh = $tab->file_info('Image', $w->{ID});
 | 
			
		||||
        next unless $fh;
 | 
			
		||||
        $w->{Image_URL} = '/images/widgets/' . $fh->File_RelativeURL;
 | 
			
		||||
    }
 | 
			
		||||
    return $widgets;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub generate_widget {
 | 
			
		||||
    my $id = shift || return;
 | 
			
		||||
    
 | 
			
		||||
    my $widget = fetch_widget($id);
 | 
			
		||||
 | 
			
		||||
    return unless $widget;
 | 
			
		||||
    return Links::SiteHTML::display('include_single_widget', $widget);
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub friendly_date {
 | 
			
		||||
    my ($date, $timestmp, $format) = @_;
 | 
			
		||||
    
 | 
			
		||||
    return unless $date;
 | 
			
		||||
 | 
			
		||||
    my $days = GT::Date::date_diff(GT::Date::date_get(time, '%yyyy%-%mm%-%dd%'), $date);
 | 
			
		||||
    unless ($days) {
 | 
			
		||||
        my $time = GT::Date::timelocal(GT::Date::parse_format($timestmp, "%yyyy%-%mm%-%dd% %HH%:%MM%:%ss%"));
 | 
			
		||||
        my $secs = time - $time;
 | 
			
		||||
        return unless $secs;
 | 
			
		||||
 | 
			
		||||
        $date = $timestmp;
 | 
			
		||||
        return "$secs seconds ago" if $secs < 60;
 | 
			
		||||
 | 
			
		||||
        my $mins = int($secs / 60);
 | 
			
		||||
        return "$mins minutes ago" if $mins < 60;
 | 
			
		||||
 | 
			
		||||
        my $hours = int($secs / 3600); 
 | 
			
		||||
        return $hours . ($hours > 1 ? " hours ago" : " hour ago");
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        my $time = GT::Date::timelocal(GT::Date::parse_format($date, "%yyyy%-%mm%-%dd%")); 
 | 
			
		||||
        $date = $time;
 | 
			
		||||
 | 
			
		||||
        return ($format or $days > 7)
 | 
			
		||||
          ? GT::Date::date_get($date, $format || "%mmm% %dd%, %yyyy%")
 | 
			
		||||
          : $days . ($days > 1 ? " days ago" : " day ago");
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub retrieve_param {
 | 
			
		||||
    my ($field, $count) = @_;
 | 
			
		||||
 | 
			
		||||
    return unless $field;
 | 
			
		||||
 | 
			
		||||
    $count ||= 1;
 | 
			
		||||
    my $vars = GT::Template->vars; 
 | 
			
		||||
 | 
			
		||||
    if ($field eq 'Image_description') {
 | 
			
		||||
        return $vars->{"Image${count}_description"};
 | 
			
		||||
    }
 | 
			
		||||
    elsif ($field =~ /^Image_(.*)$/) {
 | 
			
		||||
        return $vars->{"Image${count}_$1"} || $vars->{"Image${count}_path"};
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        return $vars->{"$field$count"};
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub fetch_thumbnail {
 | 
			
		||||
    my $link = shift || return;
 | 
			
		||||
 | 
			
		||||
    if ($link->{Link_Type} eq VIDEO) {
 | 
			
		||||
        if ($link->{Thumbnail_URL} and $link->{Thumbnail_URL} ne 'http://') {
 | 
			
		||||
            return { small => $link->{Thumbnail_URL} };
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            my $field = Plugins::ConvertVideo::get_file_path($link->{ID}, "thumbnail_file_field");
 | 
			
		||||
            return $field->{thumbnail_file_field_path}
 | 
			
		||||
                ? {
 | 
			
		||||
                        small   => $field->{thumbnail_file_field_path},
 | 
			
		||||
                        medium  => $field->{thumbnail_file_field_path},
 | 
			
		||||
                        large   => $field->{thumbnail_file_field_path},
 | 
			
		||||
                        largest => $field->{thumbnail_file_field_path},
 | 
			
		||||
                  }
 | 
			
		||||
                : undef;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        my $slideshow = Plugins::SlideShow::generate_paths($link->{ID});
 | 
			
		||||
        if ($slideshow and $slideshow->{image_loop}) {
 | 
			
		||||
            return {
 | 
			
		||||
                small   => $slideshow->{image_loop}->[0]{_thumbnail_path},
 | 
			
		||||
                medium  => $slideshow->{image_loop}->[0]{_medium_path},
 | 
			
		||||
                large   => $slideshow->{image_loop}->[0]{_large_path},
 | 
			
		||||
                largest => $slideshow->{image_loop}->[0]{_largest_path}
 | 
			
		||||
            };
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub slideshow_url {
 | 
			
		||||
    my $url = shift || return;
 | 
			
		||||
 | 
			
		||||
    $url =~ s,^$CFG->{build_detail_url},$CFG->{build_detail_url}/Photos,;
 | 
			
		||||
    return $url;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub rewrite_breadcrumbs {
 | 
			
		||||
    my ($title_loop, $mode) = @_;
 | 
			
		||||
    
 | 
			
		||||
    return unless ref $title_loop;
 | 
			
		||||
 | 
			
		||||
    my @loop;
 | 
			
		||||
    foreach my $i (0 .. scalar @$title_loop - 1) {
 | 
			
		||||
        my $item = $title_loop->[$i];
 | 
			
		||||
        if ($i == 1) {
 | 
			
		||||
            if ($item->{Name} =~ /rd\s*aids/i) {
 | 
			
		||||
                push @loop, {
 | 
			
		||||
                    Name => "Races",
 | 
			
		||||
                    URL  => "$CFG->{build_root_url}/Races/index.html"
 | 
			
		||||
                };
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($mode) {
 | 
			
		||||
                push @loop, {
 | 
			
		||||
                    Name => $mode eq 'photo' ? 'Photo Galleries' : 'Videos',
 | 
			
		||||
                    URL  => "$CFG->{build_root_url}/" . ($mode eq 'photo' ? 'Photos' : 'Videos') . "/index.html"
 | 
			
		||||
                };
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($item->{Name} !~ /home|bike\s*fit|products|races|articles|photos|videos|coaching|podcast|privacy|about|agreement/i) {
 | 
			
		||||
                push @loop, {
 | 
			
		||||
                    Name => "Articles",
 | 
			
		||||
                    URL  => "$CFG->{build_root_url}/Articles/index.html"
 | 
			
		||||
                };
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
        push @loop, $item;
 | 
			
		||||
    }
 | 
			
		||||
    return \@loop;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub build_category {
 | 
			
		||||
    my $opts = shift;
 | 
			
		||||
    $opts->{id} ||= $IN->param('ID');
 | 
			
		||||
 | 
			
		||||
    return @_ unless $opts->{id};
 | 
			
		||||
 | 
			
		||||
    my $cfg = Links::Plugins->get_plugin_user_cfg('UI');
 | 
			
		||||
    return @_ unless $cfg and $cfg->{merge_categories};
 | 
			
		||||
 | 
			
		||||
    my %ids = map { $_ => 1 } split(/\s*,\s*/, $cfg->{merge_categories});
 | 
			
		||||
    return @_ unless $ids{$opts->{id}};
 | 
			
		||||
 | 
			
		||||
    GT::Plugins->action( STOP );
 | 
			
		||||
 | 
			
		||||
    my $cat_db     = $DB->table('Category');
 | 
			
		||||
    my $link_db    = $DB->table('Links');
 | 
			
		||||
    my $catlink_db = $DB->table('Links', 'CatLinks');
 | 
			
		||||
    my $related_db = $DB->table('CatRelations');
 | 
			
		||||
    $Links::Build::GRAND_TOTAL ||= Links::Build::_grand_total();
 | 
			
		||||
 | 
			
		||||
    if (ref $opts ne 'HASH') {
 | 
			
		||||
        Links::debug("Invalid argument passed to build_category: $opts") if $Links::DEBUG;
 | 
			
		||||
        return @_;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
# Load our category info.
 | 
			
		||||
    my $category;
 | 
			
		||||
    if ($opts->{id}) {
 | 
			
		||||
        $category = $cat_db->get($opts->{id}, 'HASH');
 | 
			
		||||
        if (! $category) {
 | 
			
		||||
            Links::debug("Invalid category id passed to build_category: $opts->{id}") if $Links::DEBUG;
 | 
			
		||||
            return;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
# Get our options.
 | 
			
		||||
    $opts->{mh} = exists $opts->{mh} ? $opts->{mh} : $CFG->{build_span_pages} ? $CFG->{build_links_per_page} : 5000;
 | 
			
		||||
    $opts->{nh} = exists $opts->{nh} ? $opts->{nh} : 1;
 | 
			
		||||
    $opts->{sb} = exists $opts->{sb} ? $opts->{sb} : $CFG->{build_sort_order_category};
 | 
			
		||||
    $opts->{so} = exists $opts->{so} ? $opts->{so} : '';
 | 
			
		||||
    if ($opts->{sb} =~ /\b(?:asc|desc)\b/i) {
 | 
			
		||||
        $opts->{so} = '';
 | 
			
		||||
    }
 | 
			
		||||
    $opts->{cat_sb} = exists $opts->{cat_sb} ? $opts->{cat_sb} : $CFG->{build_category_sort};
 | 
			
		||||
    $opts->{cat_so} = exists $opts->{cat_so} ? $opts->{cat_so} : '';
 | 
			
		||||
    if ($opts->{cat_sb} =~ /\b(?:asc|desc)\b/i) {
 | 
			
		||||
        $opts->{cat_so} = '';
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
# Figure out the template set to use.
 | 
			
		||||
    $category->{Category_Template} ||= $cat_db->template_set($category->{ID});
 | 
			
		||||
 | 
			
		||||
# Get our output vars.
 | 
			
		||||
    my %tplvars = (
 | 
			
		||||
        %$category,
 | 
			
		||||
        category_id   => $category->{ID},
 | 
			
		||||
        category_name => $category->{Full_Name},
 | 
			
		||||
        header        => $category->{Header},
 | 
			
		||||
        footer        => $category->{Footer},
 | 
			
		||||
        meta_name     => $category->{Meta_Description},
 | 
			
		||||
        meta_keywords => $category->{Meta_Keywords},
 | 
			
		||||
        description   => $category->{Description},
 | 
			
		||||
        random        => int rand 10000,
 | 
			
		||||
        random1       => int rand 10000,
 | 
			
		||||
        random2       => int rand 10000,
 | 
			
		||||
        random3       => int rand 10000
 | 
			
		||||
    );
 | 
			
		||||
 | 
			
		||||
# Clean up the name.
 | 
			
		||||
    my $clean_name = $cat_db->as_url($category->{Full_Name});
 | 
			
		||||
    my $build_title = $category->{Full_Name};
 | 
			
		||||
    $build_title .= '/' . Links::language('LINKS_PAGE', $opts->{nh}) if $opts->{nh} and $opts->{nh} > 1;
 | 
			
		||||
 | 
			
		||||
    $tplvars{title_loop}   = Links::Build::build('title', $build_title);
 | 
			
		||||
    $tplvars{title_linked} = sub { Links::Build::build('title_linked', $build_title) };
 | 
			
		||||
    $tplvars{title}        = sub { Links::Build::build('title_unlinked', $build_title) };
 | 
			
		||||
 | 
			
		||||
    $tplvars{category_name_escaped} = GT::CGI->escape($category->{Full_Name});
 | 
			
		||||
    $tplvars{category_clean}   = $tplvars{title};
 | 
			
		||||
    ($tplvars{category_short}) = $tplvars{category_name} =~ m|([^/]+)$|;
 | 
			
		||||
 | 
			
		||||
    # CUSTOMIZED: show all links in a category as well as subcategories
 | 
			
		||||
    my $categories = $cat_db->children($category->{ID});
 | 
			
		||||
    push @$categories, $category->{ID};
 | 
			
		||||
 | 
			
		||||
    my $cond = GT::SQL::Condition->new(
 | 
			
		||||
        CategoryID  => '=' => $categories,
 | 
			
		||||
        isValidated => '=' => 'Yes'
 | 
			
		||||
    );
 | 
			
		||||
 | 
			
		||||
# "Optional" payment categories are a hassle, as we have to do two selects,
 | 
			
		||||
# then balance out the mh/nh variables between the two.
 | 
			
		||||
    my ($optional_sth, $sth);
 | 
			
		||||
    my @select_options;
 | 
			
		||||
    push @select_options, "ORDER BY $opts->{sb} $opts->{so}" if $opts->{sb};
 | 
			
		||||
 | 
			
		||||
# Load payment info if payment is enabled. Change sort order by paid links
 | 
			
		||||
# first then free links if payment for this category is optional. If payment
 | 
			
		||||
# is required, we need to remove unpaid links
 | 
			
		||||
    if ($CFG->{payment}->{enabled}) {
 | 
			
		||||
        require Links::Payment;
 | 
			
		||||
        my $payment_info = Links::Payment::cat_payment_info($opts->{id});
 | 
			
		||||
 | 
			
		||||
        if ($payment_info->{mode} == OPTIONAL and $CFG->{build_sort_paid_first}) {
 | 
			
		||||
            my $paycond = GT::SQL::Condition->new($cond);
 | 
			
		||||
            $paycond->add(ExpiryDate => '>=' => time, ExpiryDate => '<=' => UNLIMITED);
 | 
			
		||||
 | 
			
		||||
            my $offset = ($opts->{nh} - 1) * $opts->{mh};
 | 
			
		||||
            $catlink_db->select_options(@select_options);
 | 
			
		||||
            $catlink_db->select_options("LIMIT $opts->{mh} OFFSET $offset");
 | 
			
		||||
            $optional_sth = $catlink_db->select('Links.*', $paycond);
 | 
			
		||||
 | 
			
		||||
            $cond->add(ExpiryDate => '=' => FREE);
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            # 1) This is an else (instead of elsif ($payment_info->{mode} == REQUIRED)) because the
 | 
			
		||||
            # run-time count updating code cannot efficiently take category settings into account
 | 
			
		||||
            # as doing so requires either subselects (which older MySQL doesn't support), or a fair
 | 
			
		||||
            # bit of Perl code; a single fast count to determine whether the check is necessary
 | 
			
		||||
            # won't work.  The end result is that counts would be off.
 | 
			
		||||
            # 2) Even if this was an elsif, we can't include ExpiryDate <= UNLIMITED (to exclude
 | 
			
		||||
            # free links) because links being free is the default for imported, upgraded, and
 | 
			
		||||
            # admin-added links, which we don't want to exclude from REQUIRED categories.
 | 
			
		||||
            $cond->add(ExpiryDate => '>=' => time);
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    my @results;
 | 
			
		||||
    my ($paid_hits, $paid_rows, $offset, $max_hits) = (0, 0, ($opts->{nh} - 1) * $opts->{mh}, $opts->{mh});
 | 
			
		||||
    if ($optional_sth) {
 | 
			
		||||
        push @results, @{$optional_sth->fetchall_hashref};
 | 
			
		||||
        $paid_rows = $optional_sth->rows;
 | 
			
		||||
        $paid_hits = $catlink_db->hits;
 | 
			
		||||
        if ($paid_rows == $opts->{mh}) {
 | 
			
		||||
            $offset = $max_hits = 0;
 | 
			
		||||
        }
 | 
			
		||||
        elsif ($paid_rows > 0) {
 | 
			
		||||
            $offset = 0;
 | 
			
		||||
            $max_hits = $opts->{mh} - $paid_rows;
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            $offset -= $paid_hits;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    my $hits;
 | 
			
		||||
# Select links from required categories, not-accepted categories, and optional
 | 
			
		||||
# categories whose paid hits haven't filled the page
 | 
			
		||||
    if ($max_hits) { # $max_hits will be 0 when mh paid links are already listed
 | 
			
		||||
        $catlink_db->select_options(@select_options);
 | 
			
		||||
        $catlink_db->select_options("LIMIT $max_hits OFFSET $offset");
 | 
			
		||||
        my @ids = map $_->[0], @{$catlink_db->select('DISTINCT LinkID', $cond)->fetchall_arrayref};
 | 
			
		||||
 | 
			
		||||
        $link_db->select_options(@select_options);
 | 
			
		||||
        my $sth = $link_db->select({ ID => \@ids });
 | 
			
		||||
 | 
			
		||||
        push @results, @{$sth->fetchall_hashref};
 | 
			
		||||
        $hits = $catlink_db->hits;
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        $hits = $catlink_db->count($cond);
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    my $numlinks = $tplvars{total} = $hits + $paid_hits;
 | 
			
		||||
    $tplvars{total_optional_paid} = $paid_hits;
 | 
			
		||||
 | 
			
		||||
# Get the links.
 | 
			
		||||
    $link_db->add_reviews(\@results);
 | 
			
		||||
    my @links_loop = map Links::SiteHTML::tags('link', $_, undef) => @results;
 | 
			
		||||
    $tplvars{links_loop} = \@links_loop;
 | 
			
		||||
    $tplvars{links_count} = @links_loop;
 | 
			
		||||
    my $links;
 | 
			
		||||
    $tplvars{links} = sub {
 | 
			
		||||
        return $links if defined $links;
 | 
			
		||||
        $links = '';
 | 
			
		||||
        for my $link (@results) {
 | 
			
		||||
            $link->{Category_Template} = $category->{Category_Template} if $category->{Category_Template};
 | 
			
		||||
            $links .= Links::SiteHTML::display('link', $link);
 | 
			
		||||
        }
 | 
			
		||||
        return $links;
 | 
			
		||||
    };
 | 
			
		||||
# Get the subcategories and related categories as either Yahoo style (integrated) or
 | 
			
		||||
# separated into two outputs..
 | 
			
		||||
    my @cat_loop;
 | 
			
		||||
    $tplvars{category_loop} = \@cat_loop;
 | 
			
		||||
    if ($CFG->{build_category_yahoo}) {
 | 
			
		||||
        my @subcat_ids = $cat_db->select(ID => { FatherID => $category->{ID} })->fetchall_list;
 | 
			
		||||
        my %related_ids = $related_db->select(qw/RelatedID RelationName/ => { CategoryID => $category->{ID} })->fetchall_list;
 | 
			
		||||
        if (@subcat_ids or keys %related_ids) {
 | 
			
		||||
            $cat_db->select_options("ORDER BY $opts->{cat_sb} $opts->{cat_so}") if $opts->{cat_sb};
 | 
			
		||||
            my $sth = $cat_db->select({ ID => [@subcat_ids, keys %related_ids] });
 | 
			
		||||
            my @rel_loop;
 | 
			
		||||
            while (my $cat = $sth->fetchrow_hashref) {
 | 
			
		||||
                $cat->{URL} = "$CFG->{build_root_url}/" . $cat_db->as_url($cat->{Full_Name}) . "/" . ($CFG->{build_index_include} ? $CFG->{build_index} : '');
 | 
			
		||||
                $cat->{RelationName} = '';
 | 
			
		||||
                if (exists $related_ids{$cat->{ID}}) {
 | 
			
		||||
                    $cat->{Related} = 1;
 | 
			
		||||
                    $cat->{RelationName} = $related_ids{$cat->{ID}};
 | 
			
		||||
# Relations with a custom name need to be re-sorted
 | 
			
		||||
                    if ($cat->{RelationName}) {
 | 
			
		||||
                        push @rel_loop, $cat;
 | 
			
		||||
                        next;
 | 
			
		||||
                    }
 | 
			
		||||
                }
 | 
			
		||||
                push @cat_loop, $cat;
 | 
			
		||||
            }
 | 
			
		||||
# Re-sort related categories using their RelationName rather than the related
 | 
			
		||||
# category's name
 | 
			
		||||
            RELATION: while (my $cat = pop @rel_loop) {
 | 
			
		||||
                for (my $i = 0; $i < @cat_loop; $i++) {
 | 
			
		||||
                    my $name = $cat_loop[$i]->{RelationName} ? $cat_loop[$i]->{RelationName} : $cat_loop[$i]->{Name};
 | 
			
		||||
                    if (lc $cat->{RelationName} lt lc $name) {
 | 
			
		||||
                        splice @cat_loop, $i, 0, $cat;
 | 
			
		||||
                        next RELATION;
 | 
			
		||||
                    }
 | 
			
		||||
                }
 | 
			
		||||
                push @cat_loop, $cat;
 | 
			
		||||
            }
 | 
			
		||||
            my $print_cat;
 | 
			
		||||
            $tplvars{category} = sub {
 | 
			
		||||
                return $print_cat if defined $print_cat;
 | 
			
		||||
                return $print_cat = Links::SiteHTML::display('print_cat', [$category, @cat_loop]);
 | 
			
		||||
            };
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            $tplvars{category} = '';
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
# Separate the output.
 | 
			
		||||
        $cat_db->select_options("ORDER BY $opts->{cat_sb} $opts->{cat_so}") if $opts->{cat_sb};
 | 
			
		||||
        $sth = $cat_db->select({ FatherID => $category->{ID} });
 | 
			
		||||
        while (my $cat = $sth->fetchrow_hashref) {
 | 
			
		||||
            $cat->{URL} = "$CFG->{build_root_url}/" . $cat_db->as_url($cat->{Full_Name}) . "/" . ($CFG->{build_index_include} ? $CFG->{build_index} : '');
 | 
			
		||||
            push @cat_loop, $cat;
 | 
			
		||||
        }
 | 
			
		||||
        if (@cat_loop) {
 | 
			
		||||
            my $print_cat;
 | 
			
		||||
            $tplvars{category} = sub {
 | 
			
		||||
                return $print_cat if defined $print_cat;
 | 
			
		||||
                return $print_cat = Links::SiteHTML::display('print_cat', [$category, @cat_loop]);
 | 
			
		||||
            };
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            $tplvars{category} = '';
 | 
			
		||||
        }
 | 
			
		||||
        $tplvars{related}  = '';
 | 
			
		||||
        $tplvars{related_loop} = [];
 | 
			
		||||
 | 
			
		||||
        my %related_ids = $related_db->select(qw/RelatedID RelationName/ => { CategoryID => $category->{ID} })->fetchall_list;
 | 
			
		||||
        if (keys %related_ids) {
 | 
			
		||||
            $cat_db->select_options("ORDER BY $opts->{cat_sb} $opts->{cat_so}") if $opts->{cat_sb};
 | 
			
		||||
            my $sth = $cat_db->select({ ID => [keys %related_ids] });
 | 
			
		||||
            while (my $cat = $sth->fetchrow_hashref) {
 | 
			
		||||
                my $url = $CFG->{build_root_url} . "/" . $cat_db->as_url($cat->{Full_Name}) . "/" . ($CFG->{build_index_include} ? $CFG->{build_index} : '');
 | 
			
		||||
                $cat->{URL} = $url;
 | 
			
		||||
                $cat->{RelationName} = $related_ids{$cat->{ID}};
 | 
			
		||||
                push @{$tplvars{related_loop}}, $cat;
 | 
			
		||||
                $tplvars{related} .= qq|<li><a href="$url">| . ($related_ids{$cat->{ID}} || $cat->{Full_Name}) . "</a></li>";
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    # Plugins can use the build_category_loop hook to change the category
 | 
			
		||||
    # results before they are returned to the template.
 | 
			
		||||
    $PLG->dispatch(build_category_loop => sub { } => \@cat_loop);
 | 
			
		||||
 | 
			
		||||
# Get the header and footer from file if it exists, otherwise assume it is html.
 | 
			
		||||
    if ($tplvars{header} and $tplvars{header} =~ /^\S{1,20}$/ and -e "$CFG->{admin_root_path}/headers/$tplvars{header}") {
 | 
			
		||||
        local (@ARGV, $/) = "$CFG->{admin_root_path}/headers/$tplvars{header}";
 | 
			
		||||
        $tplvars{header} = <>;
 | 
			
		||||
    }
 | 
			
		||||
    if ($tplvars{footer} and $tplvars{footer} =~ /^\S{1,20}$/ and -e "$CFG->{admin_root_path}/footers/$tplvars{footer}") {
 | 
			
		||||
        local (@ARGV, $/) = "$CFG->{admin_root_path}/footers/$tplvars{footer}";
 | 
			
		||||
        $tplvars{footer} = <>;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
# If we are spanning pages, figure out toolbars and such.
 | 
			
		||||
    if ($CFG->{build_span_pages}) {
 | 
			
		||||
        my $lpp = $CFG->{build_links_per_page};
 | 
			
		||||
        my $nh  = $opts->{nh};
 | 
			
		||||
        my $url = $CFG->{build_root_url}  . "/" . $clean_name;
 | 
			
		||||
        $tplvars{next} = $tplvars{prev} = "";
 | 
			
		||||
        if ($numlinks > ($nh * $lpp)) {
 | 
			
		||||
            $tplvars{next} = "$url/$CFG->{build_more}" . ($nh + 1) . "$CFG->{build_extension}";
 | 
			
		||||
        }
 | 
			
		||||
        if ($nh == 2) {
 | 
			
		||||
            $tplvars{prev} = "$url/" . ($CFG->{build_index_include} ? $CFG->{build_index} : '');
 | 
			
		||||
        }
 | 
			
		||||
        elsif ($nh > 2) {
 | 
			
		||||
            $tplvars{prev} = "$url/$CFG->{build_more}" . ($nh - 1) . "$CFG->{build_extension}";
 | 
			
		||||
        }
 | 
			
		||||
        if ($tplvars{next} or $tplvars{prev}) {
 | 
			
		||||
            $tplvars{next_span} = Links::Build::build('toolbar', { url => $url, numlinks => $numlinks, nh => $nh });
 | 
			
		||||
            $tplvars{paging} = {
 | 
			
		||||
                page         => "$clean_name/",
 | 
			
		||||
                page_format  => 1,
 | 
			
		||||
                num_hits     => $numlinks,
 | 
			
		||||
                max_hits     => $opts->{mh},
 | 
			
		||||
                current_page => $opts->{nh}
 | 
			
		||||
            };
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return Links::SiteHTML::display('category', \%tplvars);
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub fetch_widget_external_links {
 | 
			
		||||
    my $id = shift || return;
 | 
			
		||||
 | 
			
		||||
    return $DB->table('WidgetLinks')->select({ WidgetID => $id })->fetchall_hashref;
 | 
			
		||||
}
 | 
			
		||||
1;
 | 
			
		||||
							
								
								
									
										322
									
								
								site/slowtwitch.com/cgi-bin/articles/admin/Plugins/Widgets.pm
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										322
									
								
								site/slowtwitch.com/cgi-bin/articles/admin/Plugins/Widgets.pm
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,322 @@
 | 
			
		||||
# ==================================================================
 | 
			
		||||
# Plugins::Widgets - Auto Generated Program Module
 | 
			
		||||
#
 | 
			
		||||
#   Plugins::Widgets
 | 
			
		||||
#   Author  : Bao Phan
 | 
			
		||||
#   Version : 1.0
 | 
			
		||||
#   Updated : Mon Mar 21 11:08:31 2016
 | 
			
		||||
#
 | 
			
		||||
# ==================================================================
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package Plugins::Widgets;
 | 
			
		||||
# ==================================================================
 | 
			
		||||
 | 
			
		||||
use strict;
 | 
			
		||||
use GT::Base;
 | 
			
		||||
use GT::Plugins qw/STOP CONTINUE/;
 | 
			
		||||
use Links qw/:objects/;
 | 
			
		||||
 | 
			
		||||
# Inherit from base class for debug and error methods
 | 
			
		||||
@Plugins::Widgets::ISA = qw(GT::Base);
 | 
			
		||||
 | 
			
		||||
# Your code begins here.
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
# ADMIN MENU OPTIONS
 | 
			
		||||
# ===================================================================
 | 
			
		||||
 | 
			
		||||
sub widgets {
 | 
			
		||||
# -------------------------------------------------------------------
 | 
			
		||||
# This subroutine will be called whenever the user clicks on 'Widgets' in the
 | 
			
		||||
# admin menu.  Remember, you need to print your own HTTP header; to do so you
 | 
			
		||||
# can use:
 | 
			
		||||
    my $args = shift || {};
 | 
			
		||||
 | 
			
		||||
    print $IN->header;
 | 
			
		||||
    Links::admin_page('widgets.html', { widgets => fetch_widgets($IN->param('page')), %$args });
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub assign {
 | 
			
		||||
    my $cgi = $IN->get_hash();
 | 
			
		||||
 | 
			
		||||
    my $msg;
 | 
			
		||||
    if ($cgi->{page} and $cgi->{id} and $cgi->{pos}) {
 | 
			
		||||
        my $widget = $DB->table('Widgets')->get($cgi->{id});
 | 
			
		||||
        my $page   = $cgi->{page};
 | 
			
		||||
 | 
			
		||||
        my $tab_pgwidgets = $DB->table('PageWidgets');
 | 
			
		||||
        my $pg_widget = $tab_pgwidgets->select({ WidgetID => $widget->{ID}, Page => $page })->fetchrow_hashref;
 | 
			
		||||
 | 
			
		||||
        my ($msg, $category);
 | 
			
		||||
 | 
			
		||||
        $category = $DB->table('Category')->get($page) if $page =~ /^\d+$/;
 | 
			
		||||
        if (!$pg_widget and $cgi->{pos} =~ /^\d+$/) {
 | 
			
		||||
            $tab_pgwidgets->insert({ WidgetID => $widget->{ID}, Page => $page, Sort_Pos => $cgi->{pos} || 0 }) or die $GT::SQL::error;
 | 
			
		||||
            $msg = "The widget was added to page: " . ($category ? $category->{Full_Name} : $page);
 | 
			
		||||
        }
 | 
			
		||||
        elsif ($cgi->{pos} =~ /^\d+$/) {
 | 
			
		||||
            $tab_pgwidgets->update({ Sort_Pos => $cgi->{pos} }, { ID => $pg_widget->{ID} });
 | 
			
		||||
            $msg = "The widget's position was updated on page: " . ($category ? $category->{Full_Name} : $page);
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            $tab_pgwidgets->delete({ ID => $pg_widget->{ID} });
 | 
			
		||||
            $msg = "The widget was removed from: " . ($category ? $category->{Full_Name} : $page);
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    return widgets({ msg => $msg });
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub add {
 | 
			
		||||
    my $cgi = $IN->get_hash();
 | 
			
		||||
 | 
			
		||||
    my $error;
 | 
			
		||||
    if ($cgi->{submit}) {
 | 
			
		||||
        # automated widget
 | 
			
		||||
        my @fields = ('ID', 'Type', 'Widget', 'Title', 'Subtitle', 'TitleStyle', 'Image', 'URL', 'Button');
 | 
			
		||||
        if ($cgi->{Type}) {
 | 
			
		||||
            return form('Widget and Title cannot be null') unless $cgi->{Widget} and $cgi->{Title};
 | 
			
		||||
 | 
			
		||||
            if ($cgi->{Widget} eq 'category_list') {
 | 
			
		||||
                return form('Select a category') unless $cgi->{Category};
 | 
			
		||||
 | 
			
		||||
                push @fields, 'Category';
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($cgi->{Widget} eq 'poll') {
 | 
			
		||||
                return form('Select a forum') unless $cgi->{Forum};
 | 
			
		||||
 | 
			
		||||
                push @fields, 'Forum';
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($cgi->{Widget} =~ /^(:?feature_article|editors_pick|feature_threads)$/) {
 | 
			
		||||
                return form('Enter Article IDs, comma separated') unless $cgi->{Articles};
 | 
			
		||||
                push @fields, 'Articles';
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($cgi->{Widget} eq 'newsletter') {
 | 
			
		||||
                return form('Enter List ID') unless $cgi->{ListID};
 | 
			
		||||
                push @fields, 'ListID';
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($cgi->{Widget} eq 'external') {
 | 
			
		||||
                return form('Enter widget title') unless $cgi->{Title};
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
        my $rec;
 | 
			
		||||
        if ($cgi->{Widget} eq 'external') {
 | 
			
		||||
            $rec = $DB->table('Widgets')->add({
 | 
			
		||||
                Title           => $cgi->{Title},
 | 
			
		||||
                TitleStyle      => $cgi->{TitleStyle},
 | 
			
		||||
                Widget          => 'external',
 | 
			
		||||
                Type            => 1
 | 
			
		||||
            });
 | 
			
		||||
            return form($GT::SQL::error) unless $rec;
 | 
			
		||||
 | 
			
		||||
            my $num_links = $cgi->{NumLinks} || 5;
 | 
			
		||||
            my $tab_links = $DB->table("WidgetLinks");
 | 
			
		||||
            for my $i (1 .. $num_links) {
 | 
			
		||||
                next unless $cgi->{"Title-$i"} and $cgi->{"Abstract-$i"} and $cgi->{"URL-$i"} and $cgi->{"URL-$i"} =~ /^http/;
 | 
			
		||||
                $tab_links->insert({
 | 
			
		||||
                    WidgetID    => $rec,
 | 
			
		||||
                    Title       => $cgi->{"Title-$i"},
 | 
			
		||||
                    Abstract    => $cgi->{"Abstract-$i"},
 | 
			
		||||
                    URL         => $cgi->{"URL-$i"},
 | 
			
		||||
                });
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            my %hash = map { $_ => $cgi->{$_} } @fields;
 | 
			
		||||
            $rec = $DB->table('Widgets')->add(\%hash);
 | 
			
		||||
            return form($GT::SQL::error) unless $rec;
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
        if ($cgi->{page}) {
 | 
			
		||||
            my $tab_pgwidgets = $DB->table('PageWidgets');
 | 
			
		||||
            my $max_pos = $tab_pgwidgets->select('MAX(Sort_Pos)', { Page => $cgi->{page} })->fetchrow || 0;
 | 
			
		||||
            $tab_pgwidgets->insert({ WidgetID => $rec, Page => $cgi->{page}, Sort_Pos => $max_pos + 1 });
 | 
			
		||||
        }
 | 
			
		||||
        return widgets({ success => "The widget was added" });
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    form();
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub modify {
 | 
			
		||||
    my $cgi    = $IN->get_hash();
 | 
			
		||||
    my $widget = $DB->table('Widgets')->get($cgi->{ID});
 | 
			
		||||
    return form("Widget not found") unless $widget;
 | 
			
		||||
 | 
			
		||||
    if ($cgi->{submit}) {
 | 
			
		||||
        # automated widget
 | 
			
		||||
        my @fields = ('ID', 'Type', 'Widget', 'Title', 'Subtitle', 'TitleStyle', 'Image', 'URL', 'Button');
 | 
			
		||||
        if ($cgi->{Type}) {
 | 
			
		||||
            return form('Widget and Title cannot be null') unless $cgi->{Widget} and $cgi->{Title};
 | 
			
		||||
 | 
			
		||||
            if ($cgi->{Widget} eq 'category_list') {
 | 
			
		||||
                return form('Select a category') unless $cgi->{Category};
 | 
			
		||||
                push @fields, 'Category';
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($cgi->{Widget} eq 'poll') {
 | 
			
		||||
                return form('Select a forum') unless $cgi->{Forum};
 | 
			
		||||
                push @fields, 'Forum';
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($cgi->{Widget} =~ /^(:?feature_article|editors_pick|feature_threads)$/) {
 | 
			
		||||
                return form('Enter Article IDs, comma separated') unless $cgi->{Articles};
 | 
			
		||||
                push @fields, 'Articles';
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($cgi->{Widget} eq 'newsletter') {
 | 
			
		||||
                return form('Enter List ID') unless $cgi->{ListID};
 | 
			
		||||
                push @fields, 'ListID';
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($cgi->{Widget} eq 'external') {
 | 
			
		||||
                return form('Enter widget title') unless $cgi->{Title};
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        my %hash  = map { $_ => $cgi->{$_} } @fields;
 | 
			
		||||
        if ($cgi->{Widget} eq 'external') {
 | 
			
		||||
            $DB->table('Widgets')->update({
 | 
			
		||||
                Title           => $cgi->{Title},
 | 
			
		||||
                TitleStyle      => $cgi->{TitleStyle},
 | 
			
		||||
            }, { ID => $cgi->{ID} });
 | 
			
		||||
 | 
			
		||||
            my $num_links = $cgi->{NumLinks} || 5;
 | 
			
		||||
            my $tab_links = $DB->table("WidgetLinks");
 | 
			
		||||
            for my $i (1 .. $num_links) {
 | 
			
		||||
                my $id = $cgi->{"ID-$i"};
 | 
			
		||||
                
 | 
			
		||||
                unless ($cgi->{"Title-$i"} and $cgi->{"URL-$i"} and $cgi->{"URL-$i"} =~ /^http/) {
 | 
			
		||||
                    $tab_links->delete({ ID => $id }) if $id;
 | 
			
		||||
                }
 | 
			
		||||
                elsif ($id) {
 | 
			
		||||
                    $tab_links->update({
 | 
			
		||||
                        Title       => $cgi->{"Title-$i"},
 | 
			
		||||
                        Abstract    => $cgi->{"Abstract-$i"},
 | 
			
		||||
                        URL         => $cgi->{"URL-$i"},
 | 
			
		||||
                    }, { ID => $id });
 | 
			
		||||
                }
 | 
			
		||||
                else {
 | 
			
		||||
                    $tab_links->insert({
 | 
			
		||||
                        WidgetID    => $cgi->{ID},
 | 
			
		||||
                        Title       => $cgi->{"Title-$i"},
 | 
			
		||||
                        Abstract    => $cgi->{"Abstract-$i"},
 | 
			
		||||
                        URL         => $cgi->{"URL-$i"},
 | 
			
		||||
                    });
 | 
			
		||||
                }
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            my $rec = $DB->table('Widgets')->modify(\%hash);
 | 
			
		||||
        }
 | 
			
		||||
        return widgets({ success => "The widget was updated" });
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        $IN->param($_, $widget->{$_}) for keys %$widget;
 | 
			
		||||
        if ($widget->{Widget} eq 'external') {
 | 
			
		||||
            my $links = $DB->table('WidgetLinks')->select({ WidgetID => $widget->{ID} })->fetchall_hashref;
 | 
			
		||||
            my $i = 1;
 | 
			
		||||
            foreach my $l (@$links) {
 | 
			
		||||
                $IN->param("$_-$i", $l->{$_}) foreach (qw/ID Title Abstract URL/);
 | 
			
		||||
                $i++;
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
        return form();
 | 
			
		||||
    }
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub retrieve_ntag {
 | 
			
		||||
    my ($name, $index) = @_;
 | 
			
		||||
    return unless $name and $index;
 | 
			
		||||
    my $vars = GT::Template->vars;
 | 
			
		||||
 | 
			
		||||
    return $vars->{"$name-$index"};
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub delete {
 | 
			
		||||
    my $tab    = $DB->table('Widgets');
 | 
			
		||||
    my $widget = $tab->get($IN->param('ID'));
 | 
			
		||||
    return widgets({ error => "Widget not found" }) unless $widget;
 | 
			
		||||
 | 
			
		||||
    $tab->delete({ ID => $widget->{ID} });
 | 
			
		||||
    $DB->table('PageWidgets')->delete({ WidgetID => $widget->{ID} });
 | 
			
		||||
    $DB->table('WidgetLinks')->delete({ WidgetID => $widget->{ID} });
 | 
			
		||||
    widgets({ success => "The widget was deleted" });
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub form {
 | 
			
		||||
    print $IN->header;
 | 
			
		||||
    my $widget = $IN->param('Widget') || '';
 | 
			
		||||
 | 
			
		||||
    Links::admin_page($widget eq 'external' ? 'widgetlink_add.html' : 'widget_add.html', { error => shift });
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub fetch_widgets {
 | 
			
		||||
    my $page = shift;
 | 
			
		||||
 | 
			
		||||
    my $tab = $DB->table('Widgets');
 | 
			
		||||
    my $tab_pgwidgets = $DB->table('PageWidgets');
 | 
			
		||||
    my $tab_category  = $DB->table('Category');
 | 
			
		||||
 | 
			
		||||
    $tab->select_options('ORDER BY Title');
 | 
			
		||||
    my $widgets = $tab->select()->fetchall_hashref;
 | 
			
		||||
 | 
			
		||||
    my (%selected, %widgets);
 | 
			
		||||
    if ($page) {
 | 
			
		||||
        %selected = map { $_->{WidgetID} => $_->{Sort_Pos} } @{$tab_pgwidgets->select({ Page => $page })->fetchall_hashref};
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    my (@selected, @noselected);
 | 
			
		||||
    foreach my $w (@$widgets) {
 | 
			
		||||
        if ($w->{Image}) {
 | 
			
		||||
            my $fh = $tab->file_info('Image', $w->{ID});
 | 
			
		||||
            $w->{Image_URL} = '/images/widgets/' . $fh->File_RelativeURL;
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        $w->{pages} = $tab_pgwidgets->select({ WidgetID => $w->{ID} })->fetchall_hashref;
 | 
			
		||||
        if ($selected{$w->{ID}}) {
 | 
			
		||||
            $w->{selected} = $selected{$w->{ID}};
 | 
			
		||||
            push @selected, $w;
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            push @noselected, $w;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    @selected = @{qsort(\@selected, 'selected', 'asc')} if scalar @selected;
 | 
			
		||||
    return { selected => \@selected, available => \@noselected };
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub fetch_categories {
 | 
			
		||||
    my $tab = $DB->table('Category');
 | 
			
		||||
 | 
			
		||||
    $tab->select_options('ORDER BY Full_Name');
 | 
			
		||||
    my $categories = $tab->select()->fetchall_hashref;
 | 
			
		||||
    return $categories;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub qsort {
 | 
			
		||||
    my ($list, $sb, $so)  = @_;
 | 
			
		||||
    my $sorted;
 | 
			
		||||
    @$sorted =
 | 
			
		||||
    sort {
 | 
			
		||||
        my $da = lc $a->{$sb};         #lower case
 | 
			
		||||
        my $db = lc $b->{$sb};
 | 
			
		||||
        my $res;
 | 
			
		||||
        if ($sb eq 'selected') {
 | 
			
		||||
            $res = $db <=> $da;
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            $res = $db cmp $da;
 | 
			
		||||
        }
 | 
			
		||||
        if ($res == 0 and $sb ne 'name') {
 | 
			
		||||
            lc $b->{name} cmp lc $a->{name};
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            $res;
 | 
			
		||||
        }
 | 
			
		||||
    } @$list;
 | 
			
		||||
 | 
			
		||||
    ($so) and @$sorted = reverse @$sorted;
 | 
			
		||||
    return $sorted;
 | 
			
		||||
}
 | 
			
		||||
1;
 | 
			
		||||
							
								
								
									
										470
									
								
								site/slowtwitch.com/cgi-bin/articles/admin/Plugins/plugin.cfg
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										470
									
								
								site/slowtwitch.com/cgi-bin/articles/admin/Plugins/plugin.cfg
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,470 @@
 | 
			
		||||
{
 | 
			
		||||
	'Auth_Facebook' => {
 | 
			
		||||
		'hooks' => [],
 | 
			
		||||
		'meta' => {
 | 
			
		||||
			'author' => 'Virginia Lo',
 | 
			
		||||
			'description' => '',
 | 
			
		||||
			'license' => 'Other',
 | 
			
		||||
			'prog_ver' => '3.2.0',
 | 
			
		||||
			'url' => 'http://www.gossamer-threads.com',
 | 
			
		||||
			'version' => '1.0'
 | 
			
		||||
		},
 | 
			
		||||
		'user' => [
 | 
			
		||||
			[
 | 
			
		||||
				'fb_postback_url',
 | 
			
		||||
				'https://www.slowtwitch.com/facebook/',
 | 
			
		||||
				'Facebook postback url',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'fb_fanpageid',
 | 
			
		||||
				'395855247207719',
 | 
			
		||||
				'',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[]
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'fb_appid',
 | 
			
		||||
				'535394536545179',
 | 
			
		||||
				'',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[]
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'fb_secret_key',
 | 
			
		||||
				'0468d894e46463929bacfb6c484be3ea',
 | 
			
		||||
				'',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[]
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'version' => '1.0'
 | 
			
		||||
	},
 | 
			
		||||
	'ConvertVideo' => {
 | 
			
		||||
		'hooks' => [
 | 
			
		||||
			[
 | 
			
		||||
				'validate_link',
 | 
			
		||||
				'PRE',
 | 
			
		||||
				'Plugins::ConvertVideo::validate_link_pre',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'modify_link',
 | 
			
		||||
				'PRE',
 | 
			
		||||
				'Plugins::ConvertVideo::modify_link_pre',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'modify_link',
 | 
			
		||||
				'POST',
 | 
			
		||||
				'Plugins::ConvertVideo::modify_link_post',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'add_link',
 | 
			
		||||
				'POST',
 | 
			
		||||
				'Plugins::ConvertVideo::add_link_post',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'form_link',
 | 
			
		||||
				'PRE',
 | 
			
		||||
				'Plugins::ConvertVideo::pre_form_link',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'form_link',
 | 
			
		||||
				'POST',
 | 
			
		||||
				'Plugins::ConvertVideo::post_form_link',
 | 
			
		||||
				'1'
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'meta' => {
 | 
			
		||||
			'author' => 'Gossamer Threads Inc.',
 | 
			
		||||
			'description' => 'Convert mpeg video to flash file.',
 | 
			
		||||
			'license' => 'Other',
 | 
			
		||||
			'prog_ver' => '3.x',
 | 
			
		||||
			'url' => 'http://www.gossamer-threads.com',
 | 
			
		||||
			'version' => '1.1'
 | 
			
		||||
		},
 | 
			
		||||
		'user' => [
 | 
			
		||||
			[
 | 
			
		||||
				'video_file_field',
 | 
			
		||||
				'File_Path',
 | 
			
		||||
				'Field name of the video file field.',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'flash_file_field',
 | 
			
		||||
				'Flash_Path',
 | 
			
		||||
				'Field name of the flash file field.',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'image_file_field',
 | 
			
		||||
				'Image_Path',
 | 
			
		||||
				'Field name of the preview image file field.',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'thumbnail_file_field',
 | 
			
		||||
				'Thumbnail_Path',
 | 
			
		||||
				'Field name of the thumbnail file field.',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'video_url_field',
 | 
			
		||||
				'URL',
 | 
			
		||||
				'Field name of the video url field.',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'flash_dimension',
 | 
			
		||||
				'630x398',
 | 
			
		||||
				'The size of the flash movie (e.g. 450x370)',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'flash_quality',
 | 
			
		||||
				'1',
 | 
			
		||||
				'quality scale (1 [best] - 31 [worst])',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'thumbnail_size',
 | 
			
		||||
				'108x108',
 | 
			
		||||
				'The size of the thumbnail.',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'watermark_file',
 | 
			
		||||
				'',
 | 
			
		||||
				'The path to the watermark image.',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'video_url',
 | 
			
		||||
				'/videos',
 | 
			
		||||
				'The url where you store the video files.',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'flowplayer_url',
 | 
			
		||||
				'/videos/static',
 | 
			
		||||
				'The url path where you store the flowplayer swf and javascript files.',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'version' => '1.1'
 | 
			
		||||
	},
 | 
			
		||||
	'HandlePage' => {
 | 
			
		||||
		'hooks' => [
 | 
			
		||||
			[
 | 
			
		||||
				'handle_page',
 | 
			
		||||
				'PRE',
 | 
			
		||||
				'Plugins::HandlePage::pre_handle_page',
 | 
			
		||||
				'1'
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'meta' => {
 | 
			
		||||
			'author' => 'Gossamer Threads Inc. (Virginia Lo)',
 | 
			
		||||
			'description' => '',
 | 
			
		||||
			'license' => 'Other',
 | 
			
		||||
			'prog_ver' => '3.3.0',
 | 
			
		||||
			'url' => 'http://www.gossamer-threads.com',
 | 
			
		||||
			'version' => '1.0'
 | 
			
		||||
		},
 | 
			
		||||
		'version' => '1.0'
 | 
			
		||||
	},
 | 
			
		||||
	'MostPopular' => {
 | 
			
		||||
		'hooks' => [
 | 
			
		||||
			[
 | 
			
		||||
				'jump_link',
 | 
			
		||||
				'PRE',
 | 
			
		||||
				'Plugins::MostPopular::jump_link',
 | 
			
		||||
				'1'
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'meta' => {
 | 
			
		||||
			'author' => 'Virginia Lo',
 | 
			
		||||
			'description' => '',
 | 
			
		||||
			'license' => 'Other',
 | 
			
		||||
			'prog_ver' => '3.2.0',
 | 
			
		||||
			'url' => 'http://www.gossamer-threads.com',
 | 
			
		||||
			'version' => '1.0'
 | 
			
		||||
		},
 | 
			
		||||
		'user' => [
 | 
			
		||||
			[
 | 
			
		||||
				'last_x_days',
 | 
			
		||||
				'14',
 | 
			
		||||
				'most popular articles over the course of the last x days.  ',
 | 
			
		||||
				'TEXT',
 | 
			
		||||
				[],
 | 
			
		||||
				[],
 | 
			
		||||
				''
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'version' => '1.0'
 | 
			
		||||
	},
 | 
			
		||||
	'OverrideModDate' => {
 | 
			
		||||
		'hooks' => [
 | 
			
		||||
			[
 | 
			
		||||
				'handle_modify',
 | 
			
		||||
				'PRE',
 | 
			
		||||
				'Plugins::OverrideModDate::pre_handle',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'user_add_link',
 | 
			
		||||
				'POST',
 | 
			
		||||
				'Plugins::OverrideModDate::post_add_link',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'modify_link',
 | 
			
		||||
				'POST',
 | 
			
		||||
				'Plugins::OverrideModDate::post_modify_link',
 | 
			
		||||
				'1'
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'meta' => {
 | 
			
		||||
			'author' => 'Gossamer Threads Inc.',
 | 
			
		||||
			'description' => 'Don\'t auto set the Add_Date and Mod_Date if a user wants to modify it. ',
 | 
			
		||||
			'license' => 'Other',
 | 
			
		||||
			'prog_ver' => '3.2.0',
 | 
			
		||||
			'url' => 'http://www.gossamer-threads.com',
 | 
			
		||||
			'version' => '1.0'
 | 
			
		||||
		},
 | 
			
		||||
		'version' => '1.0'
 | 
			
		||||
	},
 | 
			
		||||
	'SlideShow' => {
 | 
			
		||||
		'hooks' => [
 | 
			
		||||
			[
 | 
			
		||||
				'add_link',
 | 
			
		||||
				'PRE',
 | 
			
		||||
				'Plugins::SlideShow::add_link',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'modify_link',
 | 
			
		||||
				'PRE',
 | 
			
		||||
				'Plugins::SlideShow::modify_link',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'user_modify_link',
 | 
			
		||||
				'PRE',
 | 
			
		||||
				'Plugins::SlideShow::check_input',
 | 
			
		||||
				'1'
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'menu' => [
 | 
			
		||||
			[
 | 
			
		||||
				'Help',
 | 
			
		||||
				'admin.cgi?do=help&topic=SlideShow/help.html" target="_blank',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'Field Management',
 | 
			
		||||
				'admin.cgi?do=plugin&plugin=SlideShow&func=field_management',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'Edit',
 | 
			
		||||
				'admin.cgi?do=page&page=plugin_manager.html&plugin_man_do=edit_installed&plugin_name=SlideShow',
 | 
			
		||||
				'1'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'Resize',
 | 
			
		||||
				'nph-imageresize.cgi',
 | 
			
		||||
				'1'
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'meta' => {
 | 
			
		||||
			'author' => 'Gossamer Threads Inc.',
 | 
			
		||||
			'description' => 'This uses the SlideShow libraries and packages to allow you to run a photo gallery. This plugin automatically creates thumbnails of uploaded pictures and allows you to view them in a special frame.',
 | 
			
		||||
			'license' => 'Commercial',
 | 
			
		||||
			'prog_ver' => '2.1.1',
 | 
			
		||||
			'url' => 'http://www.gossamer-threads.com/',
 | 
			
		||||
			'version' => '1.20070309'
 | 
			
		||||
		},
 | 
			
		||||
		'user' => [
 | 
			
		||||
			[
 | 
			
		||||
				'max_upload_constraints',
 | 
			
		||||
				'2000x2000',
 | 
			
		||||
				'Maximum size allowed for the uploaded image.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'max_upload_size',
 | 
			
		||||
				'1000000',
 | 
			
		||||
				'Maximum size in bytes for the uploaded image.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'link_type_1',
 | 
			
		||||
				'article',
 | 
			
		||||
				'Link type for image width and height constraint.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'thumbnail_constraints_1',
 | 
			
		||||
				'100x100',
 | 
			
		||||
				'Maximum width and height for thumbnail for link_type_1.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'medium_constraints_1',
 | 
			
		||||
				'300x300',
 | 
			
		||||
				'Maximum width and height for medium sized image for link_type_1.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'large_constraints_1',
 | 
			
		||||
				'crop470x260',
 | 
			
		||||
				'Maximum width and height for large image for link_type_1.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'largest_constraints_1',
 | 
			
		||||
				'620x620',
 | 
			
		||||
				'Maximum width and height for largest image for link_type_1.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'link_type_2',
 | 
			
		||||
				'photo',
 | 
			
		||||
				'Link type for image width and height constraint.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'thumbnail_constraints_2',
 | 
			
		||||
				'crop107x80',
 | 
			
		||||
				'Maximum width and height for thumbnail for link_type_2.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'medium_constraints_2',
 | 
			
		||||
				'crop300x166',
 | 
			
		||||
				'Maximum width and height for medium sized image for link_type_2.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'large_constraints_2',
 | 
			
		||||
				'crop470x260',
 | 
			
		||||
				'Maximum width and height for large image for link_type_2.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'largest_constraints_2',
 | 
			
		||||
				'620x620',
 | 
			
		||||
				'Maximum width and height for largest image for link_type_2.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'image_quality',
 | 
			
		||||
				'100',
 | 
			
		||||
				'Used for JPGs and other lossy formats. Enter the percentage quality desired.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'watermark_path',
 | 
			
		||||
				'',
 | 
			
		||||
				'Path to the watermark file. Should be a small black and white image.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'image_cols',
 | 
			
		||||
				'Image1,Image2,Image3,Image4,Image5,Image6,Image7,Image8,Image9,Image10,Image11,Image12,Image13,Image14,Image15,Image16,Image17,Image18,Image19,Image20',
 | 
			
		||||
				'Name of image columns, separate with commas'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'seq_image_cols',
 | 
			
		||||
				'Image1_medium,Image2_medium,Image3_medium,Image4_medium,Image5_medium,Image6_medium,Image7_medium,Image8_medium,Image9_medium,Image10_medium,Image11_medium,Image12_medium,Image13_medium,Image14_medium,Image15_medium,Image16_medium,Image17_medium,Image18_medium,Image19_medium,Image20_medium',
 | 
			
		||||
				'For the next/previous pager on the showpicture.cgi. The list of columns that can be paged through.'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'temp_dir',
 | 
			
		||||
				'/var/home/slowtwitch/slowtwitch.com/cgi-bin/articles/admin/tmp',
 | 
			
		||||
				'Temporary directory for image work'
 | 
			
		||||
			],
 | 
			
		||||
			[
 | 
			
		||||
				'image_url_path',
 | 
			
		||||
				'/articles/images',
 | 
			
		||||
				'URL to the uploaded images. This is the http:// prefixed URL to the directory that will receive all your images.'
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'version' => '1.20100817'
 | 
			
		||||
	},
 | 
			
		||||
	'UI' => {
 | 
			
		||||
		'hooks' => [
 | 
			
		||||
			[
 | 
			
		||||
				'build_category',
 | 
			
		||||
				'PRE',
 | 
			
		||||
				'Plugins::UI::build_category',
 | 
			
		||||
				'1'
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'meta' => {
 | 
			
		||||
			'author' => 'Bao Phan',
 | 
			
		||||
			'description' => '',
 | 
			
		||||
			'license' => 'Freeware',
 | 
			
		||||
			'prog_ver' => '3.3.0',
 | 
			
		||||
			'url' => '',
 | 
			
		||||
			'version' => '1.0'
 | 
			
		||||
		},
 | 
			
		||||
		'user' => [
 | 
			
		||||
			[
 | 
			
		||||
				'merge_categories',
 | 
			
		||||
				'4',
 | 
			
		||||
				'Category IDs to apply the merging option'
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'version' => '1.0'
 | 
			
		||||
	},
 | 
			
		||||
	'Widgets' => {
 | 
			
		||||
		'menu' => [
 | 
			
		||||
			[
 | 
			
		||||
				'Widgets',
 | 
			
		||||
				'admin.cgi?do=plugin&plugin=Widgets&func=widgets',
 | 
			
		||||
				'1'
 | 
			
		||||
			]
 | 
			
		||||
		],
 | 
			
		||||
		'meta' => {
 | 
			
		||||
			'author' => 'Bao Phan',
 | 
			
		||||
			'description' => '',
 | 
			
		||||
			'license' => 'Freeware',
 | 
			
		||||
			'prog_ver' => '3.3.0',
 | 
			
		||||
			'url' => 'http://gt.net',
 | 
			
		||||
			'version' => '1.0'
 | 
			
		||||
		},
 | 
			
		||||
		'version' => '1.0'
 | 
			
		||||
	}
 | 
			
		||||
};
 | 
			
		||||
 | 
			
		||||
# vim:syn=perl:ts=4:noet
 | 
			
		||||
		Reference in New Issue
	
	Block a user