discourse-legacysite-perl/site/slowtwitch.com/cgi-bin/articles/admin/nph-1.cgi
2024-06-17 21:49:12 +10:00

1029 lines
34 KiB
Perl
Executable File

#!/usr/local/bin/perl
# ==================================================================
# Gossamer Links - enhanced directory management system
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info : 087,071,086,086,085
# Revision : $Id: nph-build.cgi,v 1.96 2009/05/09 17:01:33 brewt Exp $
#
# Copyright (c) 2001 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
# Notes about build changed
# -------------------------
# The only pages which are built conditionally are the detailed pages (if enabled)
# and the category pages. Detailed pages and category pages are built when the
# Timestmp column of the Links and Category tables are newer the last_build time.
# Because of this, you should not make any full table changes to the Links and
# Category data as it will lead to build_changed unnecessarily re-building all the
# pages.
# Load Time::HiRes if available for better time checking.
# Must appear here, or we get strange errors.
BEGIN { eval { require Time::HiRes; import Time::HiRes qw/time/; }; }
use strict;
use lib '/var/home/slowtwitch/slowtwitch.com/cgi-bin/articles/admin';
use vars qw/$USE_HTML $TIME_START $TOTAL_TIME @CARP_NOT $GRAND_TOTAL/;
use Links qw/:objects :payment/;
use Links::Build;
use GT::File::Tools qw/mkpath dirname/;
use Carp;
@CARP_NOT = 'GT::Plugins';
$| = 1;
local $SIG{__DIE__} = \&Links::fatal;
Links::init('/var/home/slowtwitch/slowtwitch.com/cgi-bin/articles/admin');
main();
sub main {
# -------------------------------------------------------------------
# Determine what we should build.
#
# Reset the total so it's re-calculated for a build in persistent environments
$GRAND_TOTAL = undef;
# Let other parts of the code know that we're building static pages right now
$STASH{building_static} = 1;
$USE_HTML = defined $ENV{REQUEST_METHOD} ? 1 : 0;
if ($USE_HTML) {
my $do = $IN->param('do') || '';
if ($do eq 'changed') { build_changed() }
elsif ($do eq 'staggered') { build_staggered() }
elsif ($do eq 'repair') { build_repair() }
else { build_all() }
}
else {
my $arg = $ARGV[0] || '';
if ($arg eq '--all') { build_all() }
elsif ($arg eq '--changed') { build_changed() }
elsif ($arg eq '--repair') { build_repair() }
elsif ($arg eq '--flags') { build_flags() }
else { usage() }
}
}
sub build_all {
# ------------------------------------------------------------------
# Rebuild the entire directory.
#
_header("Building All Links.", "Gossamer Links is now converting your entire directory into a series of HTML pages.");
# Create backup file.
_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, {});
# 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, {});
# Build Detailed Page.
$PLG->dispatch('create_detailed', \&_build_detailed, {});
# Build Category Pages.
$PLG->dispatch('create_category', \&_build_category, {});
_footer();
$CFG->{last_build} = time;
$CFG->save;
}
sub build_changed {
# ------------------------------------------------------------------
# Rebuild only changed pages.
#
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%');
_header("Building Links Changed Since $time", "Gossamer Links is now updating your main pages, and any category or detailed pages that have changed since you last built.");
# Build Changed Detailed Page.
require GT::SQL::Condition;
$CFG->{debug_level} = 1;
$PLG->dispatch('create_detailed_changed', \&_build_detailed, GT::SQL::Condition->new('Links.ID', '=', 2527)); #[503,613,775,918,959,1246,1446,2564]));
_footer();
$CFG->{debug_level} = 0;
return;
# 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, {});
# 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, {});
# Build Changed Detailed Page.
$PLG->dispatch('create_detailed_changed', \&_build_detailed, GT::SQL::Condition->new('Links.Timestmp', '>', $time));
# Build Changed Category Pages.
$PLG->dispatch('create_category_changed', \&_build_category, GT::SQL::Condition->new('Timestmp', '>', $time));
_footer();
$CFG->{last_build} = time;
$CFG->save;
}
sub build_staggered {
# ------------------------------------------------------------------
# Rebuild all, but stagger over multiple requests.
#
my $stage = $IN->param('s') || 1;
my $start_time = $IN->param('started') || time;
if ($stage == 1) {
_header(
"Building Staggered: Creating backup file.",
"Gossamer Links is now creating a backup file that you can use to restore your directory in case of emergency.",
"nph-build.cgi?do=staggered&s=2&started=$start_time",
$start_time
);
_build_backup();
_footer();
}
elsif ($stage == 2) {
_header(
"Building Staggered: Updating Link Flags.",
"Gossamer Links is now updating the new, changed and popular flags.",
"nph-build.cgi?do=staggered&s=3&started=$start_time",
$start_time
);
_build_reset_hits();
_build_new_flags();
_build_changed_flags();
_build_cool_flags();
_footer();
}
elsif ($stage == 3) {
_header(
"Building Staggered: Build Home, New, Cool.",
"Gossamer Links is now updating your main pages.",
"nph-build.cgi?do=staggered&s=4&started=$start_time",
$start_time
);
$PLG->dispatch('create_home', \&_build_home, {});
$PLG->dispatch('create_new', \&_build_new, {});
$PLG->dispatch('create_cool', \&_build_cool, {});
$PLG->dispatch('create_ratings', \&_build_ratings, {});
_footer();
}
elsif ($stage == 4 and $CFG->{build_detailed}) {
my $count = $DB->table($CFG->{build_detail_format} eq '%ID%' ? 'Links' : ('Links', 'Category', 'CatLinks'))->count;
my $page = $IN->param('p') || 1;
my $offset = $IN->param('o') || 500;
my $total = int($count / $offset);
$total++ if $count % $offset or !$total;
_header(
"Building Detailed Pages: Page $page of $total",
"Gossamer Links is now updating your detailed pages.",
"nph-build.cgi?do=staggered&started=$start_time&s=" . ($page >= $total ? 5 : "4&p=" . ($page+1) . "&o=$offset"),
$start_time
);
$PLG->dispatch('create_detailed_staggered', \&_build_detailed, { page => $page, limit => $offset });
_footer();
}
elsif ($stage == 5 or $stage == 4 and !$CFG->{build_detailed}) {
my $db = $DB->table('Category');
my $count = $db->count;
my $page = $IN->param('p') || 1;
my $offset = $IN->param('o') || 10;
my $total = int($count / $offset);
$total++ if $count % $offset;
$total or $total++;
_header(
"Building Categories: Page $page of $total",
"Gossamer Links is now rebuilding your category pages.",
"nph-build.cgi?do=staggered&started=$start_time&s=" . ($page >= $total ? '6' : "5&p=" . ($page + 1) . "&o=$offset"),
$start_time
);
$PLG->dispatch('create_category_staggered', \&_build_category, { page => $page, offset => $offset });
_footer();
}
elsif ($stage == 6) {
_header(
"Building Staggered: All Done",
"Gossamer Links has finished converting your directory to HTML pages.",
undef,
$start_time
);
print "All pages have been successfully updated.\n\n";
_footer();
$CFG->{last_build} = time;
$CFG->save;
}
}
sub build_repair {
# ------------------------------------------------------------------
# Repair tables.
#
_header(
"Repairing tables.",
"Gossamer Links is now ensuring that your category counts are correct."
);
_reset_sequences();
_reset_expired_links();
_build_catlinks_orphan_check();
_reset_category_stats();
_build_reset_hits();
_build_orphan_check();
_build_new_flags({ reset => 1 });
_build_changed_flags({ reset => 1 });
_build_cool_flags();
_footer();
}
sub build_flags {
# ------------------------------------------------------------------
# Reset flags.
#
_header(
"Resetting flags.",
"Gossamer Links is now going to reset the new, cool, and popular flags."
);
_build_new_flags({ reset => 1 });
_build_changed_flags({ reset => 1 });
_build_cool_flags();
_footer();
}
sub usage {
# ------------------------------------------------------------------
# Return a usage statement if called from shell.
#
print <<USAGE;
Usage:
$0 --all
$0 --changed
$0 --repair
$0 --flags
where:
--all will rebuild all html pages.
--changed will rebuild home, new, cool, and detailed/category pages
that have changed.
--repair will rebuild the link counts in the category tables.
--flags will update the new, cool and popular flags.
USAGE
exit;
}
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_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_new {
# ------------------------------------------------------------------
# Generate the what's new listings.
#
_time_start();
# We are either generating a single html page, or an index and follow up pages.
my $page = $CFG->{build_new_path} . "/" . $CFG->{build_index};
my $url = $CFG->{build_new_url} . "/" . $CFG->{build_index};
print $USE_HTML
? qq|Building <a href="$url" target="_blank">What's New Index</a>...\n|
: qq|Building What's New Index...\n|;
if ($CFG->{build_span_pages}) {
{
my $fh = _open_write($page);
print $fh Links::Build::build(new_index => {});
}
my $perms = oct $CFG->{build_file_per};
chmod $perms, $page;
# Now let's build any sub pages.
my $db = $DB->table('Links');
$db->select_options("GROUP BY Add_Date");
my $sth = $db->select(Add_Date => 'COUNT(*)', { isNew => 'Yes' }, VIEWABLE);
while (my ($date, $count) = $sth->fetchrow_array) {
$date =~ s/\s(.*)//;
$page = $CFG->{build_new_path} . "/" . $date . $CFG->{build_extension};
$url = $CFG->{build_new_url} . "/" . $date . $CFG->{build_extension};
print $USE_HTML
? "\tBuilding Subpage: <a href='$url' target='_blank'>$date</a>..."
: "\tBuilding Subpage: $date...";
my $lpp = $CFG->{build_links_per_page} || 25;
my $num_pages = int($count / $lpp);
$num_pages++ if $count % $lpp;
# Print the main page.
{
my $fh = _open_write($page);
print $fh Links::Build::build(new_subpage => { date => $date, nh => 1, mh => $lpp });
}
my $perms = oct $CFG->{build_file_per};
chmod $perms, $page;
# Print the sub pages.
for my $i (2 .. $num_pages) {
$page = "$CFG->{build_new_path}/${date}_$i$CFG->{build_extension}";
$url = "$CFG->{build_new_url}/${date}_$i$CFG->{build_extension}";
{
my $fh = _open_write($page);
print $fh Links::Build::build(new_subpage => { date => $date, nh => $i, mh => $lpp });
}
my $perms = oct $CFG->{build_file_per};
chmod $perms, $page;
print $USE_HTML
? qq|<a href="$url" target="_blank">$i</a> |
: "$i ";
}
print " $count links okay.\n";
}
}
else {
{
my $fh = _open_write($page);
print $fh Links::Build::build(new => {});
}
my $perms = oct $CFG->{build_file_per};
chmod $perms, $page;
}
_display_time();
}
sub _build_cool {
# ------------------------------------------------------------------
# Generate the what's cool listings.
#
_time_start();
my $page = $CFG->{build_cool_path} . "/" . $CFG->{build_index};
my $url = $CFG->{build_cool_url} . "/" . $CFG->{build_index};
print $USE_HTML
? "Building <a href='$url' target='_blank'>What's Cool Index</a>..."
: "Building What's Cool Index...";
# If we are spanning pages.
if ($CFG->{build_span_pages}) {
my $db = $DB->table('Links');
my $total = $db->count({ isPopular => 'Yes' }, VIEWABLE);
my $lpp = $CFG->{build_links_per_page} || 25;
my $num_pages = int($total / $lpp);
$num_pages++ if $total % $lpp;
$num_pages ||= 1;
for my $i (1 .. $num_pages) {
if ($i > 1) {
$page = $CFG->{build_cool_path} . "/$CFG->{build_more}$i$CFG->{build_extension}";
$url = $CFG->{build_cool_url} . "/$CFG->{build_more}$i$CFG->{build_extension}";
}
{
my $fh = _open_write($page);
print $fh Links::Build::build(cool => { nh => $i, mh => $lpp });
}
my $perms = oct $CFG->{build_file_per};
chmod($perms, $page);
print $USE_HTML
? "<a href='$url' target='_blank'>$i</a> "
: "$i ";
}
print $USE_HTML ? "<br>" : "\n";
}
else {
{
my $fh = _open_write($page);
print $fh Links::Build::build(cool => {});
}
my $perms = oct $CFG->{build_file_per};
chmod $perms, $page;
}
_display_time();
}
sub _build_ratings {
# ------------------------------------------------------------------
# Generate the ratings page.
#
_time_start();
my $page = $CFG->{build_ratings_path} . "/" . $CFG->{build_index};
my $url = $CFG->{build_ratings_url} . "/" . $CFG->{build_index};
print $USE_HTML
? qq|Building <a href="$url" target="_blank">Top Rated</a>...\n|
: "Building Top Rated...\n";
{
my $fh = _open_write($page);
print $fh Links::Build::build(rating => {});
}
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);
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;
$USE_HTML ?
print qq'<a href="$url" target="_blank">$link->{ID}</a> ' :
print "$link->{ID} ";
print "\n\t" if ++$count % 20 == 0;
}
$offset++;
}
print "\n";
_display_time();
}
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_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_orphan_check {
# ------------------------------------------------------------------
# Check for orphan links.
#
_time_start();
print "Checking for orphan links...\n";
my @orphans = Links::Build::build(orphan_check => { select => ['Title', 'ID'] });
if (@orphans) {
print "\tThere are " . @orphans . " links that are not in a category. Please modify or delete the following links";
if ($USE_HTML) {
print qq| (<form method="post" action="admin.cgi" onsubmit="return confirm('Are you sure you want to delete | . @orphans . qq| orphaned links?')" style="display: inline"><input type="hidden" name="db" value="Links" /><input type="hidden" name="do" value="delete_records" />|;
my $i;
for (@orphans) {
$i++;
print qq|<input type="hidden" name="$i-ID" value="$_->{ID}" /><input type="hidden" name="delete" value="$i" />|;
}
print qq|<input type="submit" value="delete all" /></form>)|;
}
print ":\n";
my $Links = $DB->table('Links');
for my $link (@orphans) {
print "\t\t$link->{ID}: $link->{Title}";
if ($USE_HTML) {
print qq~ - <a href="admin.cgi?db=Links&do=modify_search_results&ID=$link->{ID}">modify</a> | <a href="admin.cgi?db=Links&do=delete_search_results&ID=$link->{ID}">delete</a>\n~;
}
}
}
_display_time();
}
sub _build_catlinks_orphan_check {
# ------------------------------------------------------------------
# Check for orphaned CatLinks entries.
#
_time_start();
print "Checking for orphaned CatLinks entries...\n";
my @orphans = Links::Build::build('catlinks_orphan_check');
if (@orphans) {
print "\tThere are " . @orphans . " CatLinks entries where there are no associated link or category... ";
# Do some hackery to get a non-subclassed CatLinks table
#my $catlinks = $DB->table('CatLinks');
my $catlinks = GT::SQL::Table->new(
name => $DB->prefix . 'CatLinks',
connect => $DB->{connect},
debug => $DB->{_debug},
_err_pkg => 'GT::SQL::Table'
);
for (@orphans) {
$catlinks->delete($_);
}
print "Fixed.\n";
}
_display_time();
}
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 _reset_sequences {
# ------------------------------------------------------------------
# Reset postgres sequences after an import.
#
return 1 unless lc $DB->driver eq 'pg';
_time_start();
print "Resetting sequences...\n";
my $p = $DB->prefix;
$DB->table('Category')->do_query("SELECT SETVAL('${p}Category_seq', MAX(ID)) FROM ${p}Category");
$DB->table('Links')->do_query("SELECT SETVAL('${p}Links_seq', MAX(ID)) FROM ${p}Links");
_display_time();
}
sub _reset_expired_links {
# -----------------------------------------------------------------------------
# Updates link expiries to FREE when the expired_is_free option is turned on
#
return unless $CFG->{payment}->{enabled} and $CFG->{payment}->{expired_is_free};
my $force = $IN->param('force');
_time_start();
print "Checking for optional, expired links to update to free...\n";
my $payment_mode = $CFG->{payment}->{mode} == REQUIRED ? [GLOBAL, REQUIRED] : REQUIRED;
my @req_cats = $DB->table('Category')->select(ID => { Payment_Mode => $payment_mode })->fetchall_list;
# All links in non-required-payment categories need to be changed to be free links.
my @to_free = $DB->table('CatLinks', 'Links')->select(ID => GT::SQL::Condition->new(
ExpiryDate => '<' => time,
isValidated => '=' => 'Yes',
GT::SQL::Condition->new(CategoryID => 'IN' => \@req_cats)->not
))->fetchall_list;
if (@to_free) {
print "\tFound " . @to_free . " links to update...";
$DB->table('Links')->update({ LinkExpired => \'ExpiryDate' }, { ID => \@to_free });
$DB->table('Links')->update({ ExpiryDate => FREE, ExpiryCounted => 0 }, { ID => \@to_free });
print " ok!\n";
}
elsif ($force) {
print "\tNo links needed updating\n";
}
_display_time();
}
sub _reset_category_stats {
# ------------------------------------------------------------------
# Reset category stats.
#
_time_start();
print "Checking category stats...\n";
my $cat_db = $DB->table('Category');
my $cat_link = $DB->table('CatLinks', 'Links', 'Category');
my $force = $IN->param('force');
$cat_db->indexing(0);
my $root_cat = $cat_db->select(qw/ID Full_Name Number_of_Links Direct_Links/ => { FatherID => 0 });
while (my ($root_id, $root_name, $nol, $dl) = $root_cat->fetchrow_array) {
my ($total, $direct) = _link_count($cat_link, $root_id, $root_name);
if ($force or $total != $nol or $direct != $dl) {
print $force ?
"\tUpdating $root_name counters..." :
"\tCategory $root_name should have $total/$direct total/direct links, but is set to $nol/$dl, repairing... ";
my ($new_nol, $new_dl) = _fix_category_stats($cat_db, $cat_link, $root_name, $root_id);
if ($new_nol != $total or $new_dl != $direct) {
print "Structure Error!\n";
_check_category_struc($cat_db, $cat_link, $root_id, $root_name);
}
else {
print "$new_nol/$new_dl ok!\n";
}
}
}
$cat_db->indexing(1);
_display_time();
}
sub _check_category_struc {
# ------------------------------------------------------------------
# Find out where the problem is in a category with the wrong link count.
#
my ($cat_db, $cat_link, $root_id, $root_name) = @_;
my $sth = $cat_db->select(
ID => Full_Name => GT::SQL::Condition->new('Full_Name', 'Like', "$root_name/%")
);
while (my ($child_id, $child_name) = $sth->fetchrow) {
my $cat_info = $cat_db->get($child_id, 'HASH', ['ID', 'Full_Name', 'Number_of_Links']);
my $total = _link_count($cat_link, $child_id, $child_name);
if ($total ne $cat_info->{Number_of_Links}) {
print "\t\t$cat_info->{Full_Name} reported: $cat_info->{Number_of_Links} real: $total\n";
}
}
}
sub _fix_category_stats {
# ------------------------------------------------------------------
# Fix category counts.
#
my ($cat_db, $cat_link, $root_name, $root_id) = @_;
$cat_db->select_options('ORDER BY Full_Name DESC');
my $sth = $cat_db->select(qw/ID Full_Name/ => GT::SQL::Condition->new(Full_Name => LIKE => "$root_name/%"));
my $link_cond = GT::SQL::Condition->new(
CategoryID => '=' => $root_id,
VIEWABLE
);
my (%count, %seen, %direct_count);
my $count = $cat_link->count($link_cond);
$count{$root_name} = $direct_count{$root_name} = $count;
while (my ($id, $name) = $sth->fetchrow_array) {
$seen{$name}++ and print "Duplicate Category Name: ($id) $name\n" and next;
$link_cond = GT::SQL::Condition->new(
CategoryID => '=' => $id,
VIEWABLE
);
my $count = $cat_link->count($link_cond);
$direct_count{$name} = $count;
$count{$name} += $count;
if ($count) {
my @uplevel = split /\//, $name;
for (0 .. $#uplevel - 1) {
my $up_name = join '/', @uplevel[0 .. $_];
$count{$up_name} += $count;
}
}
}
while (my ($name, $count) = each %count) {
my $res = $cat_db->update({ Number_of_Links => $count, Direct_Links => $direct_count{$name} }, { Full_Name => $name });
}
return ($count{$root_name}, $direct_count{$root_name});
}
sub _link_count {
# ------------------------------------------------------------------
# Given a Category => CatLinks => Links relation, a category ID, and a category
# name, returns the calculated Number_of_Links value in scalar context, or, in
# list context, the calculated Number_of_Links value and the calculated
# Direct_Links value.
#
my ($cat_link, $cat_id, $cat_name) = @_;
my $child_links = $cat_link->count(
GT::SQL::Condition->new(
Full_Name => LIKE => "$cat_name/%",
VIEWABLE
)
);
my $direct_links = $cat_link->count(
GT::SQL::Condition->new(
CategoryID => '=' => $cat_id,
VIEWABLE
)
);
return wantarray ? ($child_links + $direct_links, $direct_links) : ($child_links + $direct_links);
}
sub _time_start {
# ------------------------------------------------------------------
# Start a timer.
#
$TIME_START = time;
}
sub _display_time {
# ------------------------------------------------------------------
# Return time results.
#
my $message = shift || 'Done';
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";
}
}