#!/usr/bin/env perl

# Copyright 2005-2024 (c) Faisal N. Jawdat
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer. Redistributions in
# binary form must reproduce the above copyright notice, this list of
# conditions and the following disclaimer in the documentation and/or
# other materials provided with the distribution. Neither the name of
# Faisal N. Jawdat nor the names of its contributors may be used to
# endorse or promote products derived from this software without specific
# prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT
# HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
# THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

use strict;
use warnings;
use FindBin qw($Bin);
use Fcntl ':mode';
use File::Copy;
use Switch;
use Cwd 'abs_path';
use Time::Local 'timelocal_nocheck';

our $VERSION = '0.82';
our $DEBUG = 0;
our ($renderpath, $stagingpath, $destinationpath, $blogpath, %support, @renderhistory);

my %argv_options;
my $usage_error = "usage $0 source-path [destination-path]\n";
my %prefs;

unless ($ENV{'EMBEDDED_IN_BEARBLOG'}) {
  local $ENV{'EMBEDDED_IN_BEAR'} = 1;

  eval "require '$Bin/bearblog';";
  if ($@) {
    $support{'blog'} = 0;
    print "Blogging support not loaded: install bearblog alongside bear.\n";
  } else {
    $support{'blog'} = 1;
  }

  eval "use Text::MultiMarkdown 'markdown';";
  if ($@) {
    die "MultiMarkdown support not loaded: Install Text::MultiMarkdown.\n";
  } else {
    $support{'markdown'} = 1;
  }

  if ((@ARGV) && (!(defined $ARGV[2]))) {
    $renderpath = abs_path($ARGV[0]);
    print "Source: $renderpath\n";

    $stagingpath = $renderpath . '/staging';
    print "Staging: $stagingpath\n";

    if (-e $renderpath) {
      if (-e $stagingpath) {
        sweep_directory($stagingpath, '<%BEAR_bodytext%>', %prefs);
      } else {
        die "ERROR - Staging path does not exist: $stagingpath\n";
      }
    } else {
      die "ERROR - Source path does not exist: $renderpath\n";
     }
  } else {
    # No output
    print "Nothing to do.\n";
    die $usage_error;
  }

  if (defined $ARGV[1]) {
    $destinationpath = $ARGV[1];
    $destinationpath =~ s/(.*)\/$/$1/;
    print "Destination: $destinationpath\n";
    publish();
  }
}

1;

sub sweep_directory {
  my ($path, $template, %prefs) = @_;

  # Make copy of dir if needed.
  my $targetpath = $path;
    $targetpath =~ s/$stagingpath/$renderpath/;

  # Enter directory, get file list.
  chdir($path);
  my @files = filter_and_sort(<*>);

  if (-e '%prefs.txt') {
    %prefs = get_prefs(%prefs);
    unless (((defined $blogpath) and (!('' eq $blogpath))) or (!(defined($prefs{'BEAR_blog_path'})))) {
      # Only set the global blogpath the first time we see it.
      # We use a global globpath instead of recalculating each time because we
      # currently only allow one blog, and letting the path get overridden
      # could cause ugly problems.
      $blogpath = $stagingpath . '/' . $prefs{'BEAR_blog_path'};
      print "Blog: $blogpath\n";
    }
  }

  if (!(-e $targetpath)) {
    mkdir($targetpath);
    print "Create: $targetpath\n";
  }

  if (-e '%template.txt') {
    ($template, %prefs) = get_template($template, %prefs);
  }

  # Sweep enclosed files and decide what to do with each.
  for my $sub_filename (@files) {
    # First handle directories we don't want to touch, then other directories,
    # then files

    my $fullpath = $path . '/' . $sub_filename;

    my @filestat = stat($fullpath);
    my $file_mode = $filestat[2];

    # Check against $sub_filename to avoid problems with filenames further
    # up the path.

    if (S_ISDIR($file_mode)) {
      sweep_directory($fullpath, $template, %prefs);
    } elsif ($sub_filename !~ /\.txt$/) {
      # If not a txt file, copy it.
      handle_copy($fullpath);
    } else {
      # If txt file, render it.
      handle_text($fullpath, $template, %prefs);
    }
  }
}

sub handle_copy {
  my ($sourcefile) = @_;

  my @sourcestat = stat($sourcefile);
  my $sourcetime = $sourcestat[9];

  my $targetfile = $sourcefile;
    $targetfile =~ s/$stagingpath/$renderpath/;

  if (-e $targetfile) {
    my @targetstat = stat($targetfile);
    my $targettime = $targetstat[9];
    if ($sourcetime gt $targettime) {
      do_copy($sourcefile, $targetfile);
    }
  } else {
    do_copy($sourcefile, $targetfile);
  }
}

sub do_copy {
  my ($sourcefile, $targetfile) = @_;

  copy($sourcefile, $targetfile);
  print "Copy: $targetfile\n";
}


sub handle_text {
  my ($sourcefile, $template, %prefs) = @_;

  push @renderhistory, $sourcefile;

  my @sourcestat = stat($sourcefile);
  my $sourcetime = $sourcestat[9];

  my $targetfile = $sourcefile;
    $targetfile =~ s/$stagingpath/$renderpath/;
    if (has_pref('BEAR_create_xhtml', %prefs)) {
      $targetfile =~ s/\.txt$/\.xhtml/;
    } else {
      $targetfile =~ s/\.txt$/\.html/;
    }

  # Do we need to do anything?
  if (-e $targetfile) {
    my @targetstat = stat($targetfile);
    my $targettime = $targetstat[9];
    if ($sourcetime gt $targettime) {
      render_html($sourcefile, $targetfile, $template, %prefs);
    }
  } else {
    render_html($sourcefile, $targetfile, $template, %prefs);
  }

}

sub render_html {
  my ($sourcefile, $targetfile, $template, %prefs) = @_;

  my $sourcebuffer = '';
  my $targetbuffer = $template;

  # Now sweep the file.
  my $still_in_prefs = 1;

  # We need the title for the blog if we are rendering from the blog path.
  my $need_title_for_blog = 0;
  if (defined $prefs{'BEAR_blog_path'}) {
    if ((!(defined $prefs{'title'})) and ($sourcefile =~ m/^$blogpath/)) {
      $need_title_for_blog = 1;
    }
  }

  open(FILE, $sourcefile) or die "Failed to open $sourcefile.\n";
  while (my $line = <FILE>) {
    if ($still_in_prefs and ($line =~ m/^%.*/)) {
      # First read in any file specific prefs.
      $line =~ /^%(.*?)\s(.*)/;
      $prefs{"$1"} = "$2";
    } else {
      # Then get the contents for rendering.
      $still_in_prefs = 0;
      unless ($need_title_for_blog) {
        $sourcebuffer .= $line;
      } else {
        $prefs{'title'} = $line;
        if (('' eq $prefs{'title'}) or ($prefs{'title'} =~ /^(\s*)$/)) {
          $prefs{'title'} = get_stub_title_from_path($sourcefile);
        }
        $need_title_for_blog = 0;
      }
    }
  }
  close(FILE);

  if (has_pref('BEAR_use_markdown', %prefs)) {
    $sourcebuffer = markdown($sourcebuffer);
  }

  # Clear out excess newlines at the beginning and end of the source buffer.
  $sourcebuffer =~ s/^(\n*)//;
  $sourcebuffer =~ s/(\n*)$//;
  $targetbuffer =~ s/<%BEAR_bodytext%>/$sourcebuffer/;

  # Now do transforms on the text.
  $targetbuffer =~ s/<%BEAR_transform (\w*?)%>/substitute_transform($1, $sourcefile, $sourcebuffer, %prefs)/eg;

  # Now do the rest of the substitutions.
  $targetbuffer =~ s/<%(\w*?)%>/substitute_pref($1, $sourcefile, %prefs)/eg;

  # Write out the target file.
  open(TARGET, "> $targetfile") or die "Failed to open $targetfile for rendering.";
  print TARGET "$targetbuffer\n";
  close(TARGET);

  print "Render: $targetfile\n";

}

sub substitute_pref {
  my ($pref, $sourcefile, %prefs) = @_;

  my $newpref = '';

  if (defined $prefs{$pref}) {
    # Get the pref.
    $newpref = $prefs{$pref};
  }

  return $newpref;
}

sub substitute_transform {
  my ($transform, $sourcefile, $sourcebuffer, %prefs) = @_;

  switch ($transform) {
    case 'quotesfile' {return transform_quotesfile($sourcebuffer)}
    case 'blog' {return transform_blog($sourcefile, %prefs)}
    case 'blogindex' {return transform_blogindex(%prefs)}
    else {return ''}
  }
}

sub transform_quotesfile {
  my ($sourcebuffer) = @_;
  # Make sure we have a spare line break to work with.
  $sourcebuffer .= "\n";
  $sourcebuffer =~ s/(.*)\n-(.*)\n/<dt>$1<\/dt><dd>-$2<\/dd>/g;
  return "$sourcebuffer";
}

sub get_prefs {
  my (%prefs) = @_;

  # Preferences are inherited. Local prefs override inherited prefs.
  my $prefsbuffer = '';
  open(PREFS, '%prefs.txt') or die "Failed to open %prefs.txt.\n";
  while (my $prefsline = <PREFS>) {
    $prefsline =~ /^%(.*?)\s(.*)/;
    $prefs{"$1"} = "$2";
  }
  close(PREFS);

  return %prefs;
}

sub get_template {
  my ($template, %prefs) = @_;

  my $templatebuffer = '';
  open(TEMPLATE, '%template.txt') or die "Failed to open %template.txt.\n";
  while (my $templateline = <TEMPLATE>) {
    $templatebuffer .= $templateline;
  }
  close(TEMPLATE);

  if (has_pref('BEAR_template_inherits', %prefs)) {
    $template =~ s/<%BEAR_bodytext%>/$templatebuffer/;
  } else {
    $template = $templatebuffer;
  }

  return ($template, %prefs);

}

sub has_pref {
  my ($pref, %prefs) = @_;
  my $other_factors_ok = 1;

  if ($pref eq 'BEAR_use_markdown') {
    $other_factors_ok = $support{'markdown'};
  }

  if ((defined $prefs{$pref}) and ($prefs{$pref} eq 'true') and $other_factors_ok) {
    return 1;
  } else {
    return 0;
  }
}

sub filter_and_sort {
  # Where we get rid of all the files we don't want to deal with so
  # sweep_directory function only has to pay attention to working files.
  #
  # Then sort directories, then alphabetical, but index.txt always gets hit
  # last. this ensures that indices and rendered files are able to work with
  # the knowledge of what got updated before.

  my @files;

  for my $file (@_) {
    if ( $file eq '.svn' ) {
      # If a subversion directory, do nothing
    } elsif ($file eq '.git' ) {
        # If a git directory, do nothing
    } elsif ($file eq 'CVS' ) {
      # If a cvs directory, do nothing
    } elsif (( $file =~ /^svn-.*\.tmp~$/) or ( $file =~ /^svn-.*\.tmp$/)) {
      # If a subversion tmp file, do nothing
    } elsif ( $file eq 'staging' ) {
      # This would cause overwriting the staging dir - do nothing
    } elsif ( $file =~ /^\./ ) {
      # If it's a .file, do nothing
    } elsif ( $file =~ /^\%/ ) {
      # If it's a %file, do nothing
    } elsif ( $file =~ /~$/ ) {
      # If it's a ~ save file, do nothing
    } else {
      # This is a file we'll work with -- put it on the list to work with
      push @files, $file;
    }
  }

  @files = sort {
    my @astat = stat($a);
    my $amode = $astat[2];
    my @bstat = stat($b);
    my $bmode = $bstat[2];

    # index.txt is always last. failing that, dirs precede files, and otherwise
    # sort alphabetically.
    if ($a eq 'index.txt') {
      return 1;
    } elsif ($b eq 'index.txt') {
      return -1;
    } elsif (!((S_ISDIR($amode)) xor (S_ISDIR($bmode)))) {
      # If both are directories or neither are directories, compare them
      # alphabetically. Two files can't have the same name, so we never return
      # equal rank.
      if ($a lt $b) {
        return -1;
      } else {
        return 1;
      }
    } else {
      # If one is a file and one is a dir, return the dir first. Note that to
      # get here one or the other but not both of them must be a dir.
      if (-d $a) {
        return -1;
      } else {
        return 1;
      }
    }
  } @files;

  return @files;
}

sub publish {

  # OK so I couldn't get File::RsyncP to do what I want. This is a kludge.

  system("/usr/bin/env rsync -rltv --exclude='*CVS*' --exclude='*.svn*' --exclude='*.git*' --exclude='*~' --exclude='.DS_Store' $renderpath/ $destinationpath/");
}