1029 lines
		
	
	
		
			34 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			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";
 | 
						|
    }
 | 
						|
}
 | 
						|
 |