#!/usr/bin/env perl
# kjbible-edittree - "kjbible"-related "build" utility
# License:  BSD-style (for this file only)
# Revision: 110905

#---------------------------------------------------------------------
#                            module setup
#---------------------------------------------------------------------

require 5.6.1;
use strict;
use Carp;
use warnings;
use Cwd;
use File::Find;
                                # Trap warnings
$SIG {__WARN__} = sub { die @_; };

#---------------------------------------------------------------------
#                           basic constants
#---------------------------------------------------------------------

use constant ZERO  => 0;        # Zero
use constant ONE   => 1;        # One
use constant TWO   => 2;        # Two

use constant FALSE => 0;        # Boolean FALSE
use constant TRUE  => 1;        # Boolean TRUE

#---------------------------------------------------------------------
#                          global variables
#---------------------------------------------------------------------

my $CWD;                        # Current working directory
my @Paths = ();                 # List of pathname entries

#---------------------------------------------------------------------
#                    directory traversal routines
#---------------------------------------------------------------------

# "AdjustList"  is a  "find"-compatible  list preprocessor.  This pre-
# processor is used by a "find" command in the main routine.

#---------------------------------------------------------------------

sub AdjustList
{
    my (@list) = @_;

    @list = grep { !-l && !m@^\.{1,2}\z@; } @list;

    if ($CWD eq '/')
    {
        @list = grep { !/^proc\z/; } @list;
    }
    elsif ($CWD =~ m@^/proc(/|\z)@)
    {
        @list = ();
    }

    @list;
}

#---------------------------------------------------------------------

# "ProcEntry"  is a  "find"-compatible file processor.  This processor
# is used by a "find" command in the main routine.

# Note: This routine must preserve "$_".

#---------------------------------------------------------------------

sub ProcEntry
{
    my $mtime;                  # Modification time
    my $path;                   # Absolute pathname
                                # Filename (provided by "File::Find")
    my $name = "$File::Find::name";

#---------------------------------------------------------------------

    $name =~ s@^(\./)+@@;       # Strip leading occurrences of "./"
    $path =  "$CWD/$name";      # Absolute pathname
    $path =~ s@^//+@/@;         # Kludge
    push (@Paths, $path);       # Save path
    undef;
}

#---------------------------------------------------------------------
#                            main routine
#---------------------------------------------------------------------

sub Main
{
    my $BaseDir;                # Base directory
    my $OutPath;                # Pathname to display
    my $LEN_CWD;                # Length of CWD path

    my $data;                   # Data buffer
    my $path;                   # Absolute path
    my $pattern;                # Pattern string
    my $str;                    # Scratch

#---------------------------------------------------------------------
# Initial setup.

    select (STDERR); $| = ONE;
    select (STDOUT); $| = ONE;
                                # Fix problems for some filesystems
    $File::Find::dont_use_nlink = ONE;
    undef $/;

#---------------------------------------------------------------------
# Directory setup operations.

    $BaseDir =  '.';            # Base is '.' (current directory)

                                # The  next  four  statements  have no
                                # effect now,  but they  may be useful
                                # later
    $BaseDir =  '.' if !defined ($BaseDir);
    $BaseDir =~ s@^(.+)/$@$1@;
    while ($BaseDir =~ s@/(\./)+@/@g) {}
    while ($BaseDir =~ s@/[^/]+/\.\./@/@g) {}

                                # Go to base directory
    chdir ($BaseDir) ||
        die "Error #01: Can't access directory: $!\n$BaseDir";

    $CWD     = getcwd();        # Get absolute path for directory
    $LEN_CWD = length ($CWD);   # Save length of absolute path

    my $base;
    ($base) = $CWD =~ m@/([^/]+)$@;
    die "Error #02\n" if !defined ($base);

#---------------------------------------------------------------------
# Build a pathname list.

    my %args =
    (
        bydepth    => TRUE ,
        preprocess => \&AdjustList ,
        wanted     => \&ProcEntry
    );

    find (\%args, '.');
    @Paths = sort @Paths;

#---------------------------------------------------------------------
# Process directory tree.

    for $path (@Paths)
    {
        $str     =  $path;
        $str     =~ s@^(.{$LEN_CWD})@@;
        $str     =~ s@^/+@@;
        $OutPath =  $str;

# Note:  ".pdf" files  *must* be skipped,  because the "-T" test isn't
# reliable for PDFs. For most other file types, filename-based exclus-
# ion isn't strictly necessary,  but it speeds things up,  because the
# time required for "-l", "-f", and "-T" tests may be  significant for
# large directory trees.

        next if $path =~
            m@\.(bz2|gif|gz|jpe?g|mp3|pdf|png|tar|zip)\z@i;

        next if -l $path;
        next if !-f $path;
        next if !-T $path;

        open (IFD, "<$path") || die "Error #03: $OutPath\n";
        binmode (IFD);
        $data = <IFD>;
        $data = "" unless defined ($data);
        close (IFD);

        next if $data =~ m@sub\s+ProcEntry@;
        my $orig_data = $data;

        $data =~ s@\015?\012@\n@gs;
        $data =~ s@\s*<link\s+rel[^<>]*>\s*@\n@gis
            if $path =~ m@(/kjv/link/|/bible\.htm\z)@;
        $data =~
s@(<frameset\s+cols=")\d+,\d+,\d+,\*">@${1}250,500,175,*">@gis;

        $data =~ s@\n{3,}@\n\n@gs;
        next if $data eq $orig_data;

        my ($mtime) = (stat $path) [9];
        die "Error #04: $path\n" unless defined ($mtime);

        open (OFD, ">$path") || die "Error #05: $path\n";
        print OFD $data;
        close (OFD) || die "Error #06: $path\n";
        utime ($mtime, $mtime, $path);
        print "$path\n";
    }

    print "Done\n";		# Print a status message
    undef;
}

#---------------------------------------------------------------------
#                            main program
#---------------------------------------------------------------------

&Main();                        # Call the main routine
exit ZERO;                      # Normal exit