#!/usr/bin/env perl

# Copyright (c) 2005-2007, 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.8';
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.\n";
  } else {
    $support{'blog'} = 1;
    print "Blogging support loaded.\n";
  }

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

  if ((@ARGV) && (!(defined $ARGV[2]))) {
    $renderpath = $ARGV[0];
    # clean up trailing slashes
    $renderpath =~ s/(.*)\/$/$1/;
    # normalize path
    unless ($renderpath =~ /^\//) {
      # partial path, add pwd
      $renderpath = $ENV{'PWD'} . '/' . $renderpath;
    }
    print "Source path: $renderpath\n";

    $stagingpath = $renderpath;
    $stagingpath .= '/staging';
    print "Staging path: $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 {
  	# output non-existent
    print "Nothing to do.\n";
  	die $usage_error;
  }

  if (defined $ARGV[1]) {
  	$destinationpath = $ARGV[1];
  	$destinationpath =~ s/(.*)\/$/$1/;
  	print "Destination path: $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 = <*>;
  @files = filter_and_sort(@files);

  if (-e '%prefs.txt') {
    %prefs = get_prefs(%prefs);
    unless ((defined $blogpath) and (!('' eq $blogpath))) {
      # 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 path: $blogpath\n";
    }
  }

	if (!(-e $targetpath)) {
  	mkdir($targetpath);
    print "Creating: $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];

    # do mostcheck checks 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$/) {
      # not a txt file, copy it
      handle_copy($fullpath);
    } else {
      # 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 "Copying to: $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 "Rendering: $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 {
  # here 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 @all_files = @_;
  my @files;
  
  for my $file (@all_files) {
    if ($file eq 'CVS' ) {
      # a cvs directory, do nothing
    } elsif ( $file eq '.svn' ) {
      # a subversion directory, do nothing
    } elsif (( $file =~ /^svn-.*\.tmp~$/) or ( $file =~ /^svn-.*\.tmp$/)) {
      # a subversion tmp file, do nothing
    } elsif ( $file eq 'staging' ) {
      # this would cause overwriting the staging dir - do nothing
    } elsif ( $file =~ /^\./ ) {
      # it's a .file, do nothing
    } elsif ( $file =~ /^\%/ ) {
      # it's a %file, do nothing
    } elsif ( $file =~ /~$/ ) {
      # 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 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='*~' --exclude='.DS_Store' $renderpath/ $destinationpath/");
}