# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Mail::Editor
#
#   Author: Jason Rhinelander
#   Revision: $Id: Editor.pm,v 1.25 2008/09/23 23:55:26 brewt Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# The backend to a web-based e-mail template editor. See the pod for
# instructions. This is designed the be used primarily from templates.
# This module respects local directories on saving, and both local and
# inheritance directories when loading.
#
# Also, any subclasses must be (something)::Editor
#

package GT::Mail::Editor;

use strict;
use vars qw($VERSION $DEBUG $ERRORS @ISA $ATTRIBS);

use GT::Base;
use GT::Template;

@ISA     = 'GT::Base';
$DEBUG   = 0;
$VERSION = sprintf "%d.%03d", q$Revision: 1.25 $ =~ /(\d+)\.(\d+)/;

$ERRORS = {
    PARSE           => "An error occurred while parsing: %s",
    NODIR           => "Template directory not specified",
    BADDIR          => "Template directory '%s' does not exist or has the permissions set incorrectly",
    NOFILE          => "No template filename specified",
    CANT_CREATE_DIR => "Unable to create directory '%s': %s",
    BADFILE         => "Template '%s' does not exist or is not readable",
    SAVEERROR       => "Unable to open '%s' for writing: %s",
    LOADERROR       => "Unable to open '%s' for reading: %s",
    RECURSION       => "Recursive inheritance detected and interrupted: '%s'",
    INVALIDDIR      => "Invalid template directory %s",
    INVALIDTPL      => "Invalid template %s",
};

$ATTRIBS = {
    dir           => '',
    template      => '',
    file          => '',
    headers       => undef,
    extra_headers => '',
    body          => ''
};

# GT::Mail::Editor::tpl_save(header => To => $header_to, header => From => $header_from, ..., extra_headers => $extra_headers)
# ($extra_headers will be parsed). Everything is optional, but you should give something to build headers from.
# It is not necessary to use To, From, etc. - you can enter them directly in the "extra_headers" field.
sub tpl_save {
    # Have to extract the three-argument arguments BEFORE getting $self
    my @headers;
    for (my $i = 0; $i < @_; $i++) {
        if ($_[$i] eq 'header') {
            push @headers, (splice @_, $i, 3)[1,2];
            redo;
        }
    }
    my $self = &_get_self;
    for (my $i = 0; $i < @headers; $i += 2) {
        $self->{headers}->{$headers[$i]} = $headers[$i+1];
    }
    if ($self->{extra_headers}) {
        for (split /\s*\n\s*/, $self->{extra_headers}) { # This will weed out any blank lines
            my ($key, $value) = split /\s*:\s*/, $_, 2;
            $self->{headers}->{$key} = $value if $key and $value;
        }
    }
    my $dir;
    if ($self->{dir} and $self->{template}) {
        $dir = "$self->{dir}/$self->{template}/local";
        if (!-d $dir) {
            # Attempt to create the "local" subdirectory
            mkdir($dir, 0777) or return $self->error(CANT_CREATE_DIR => 'FATAL' => $dir => "$!");
            chmod(0777, $dir);
        }
    }
    elsif ($self->{dir}) {
        $dir = $self->{dir};
    }

    local *FILE;
    $self->{_error} = [];
    if (not $dir) {
        $self->error(NODIR => 'WARN');
    }
    elsif (not -d $dir or not -w $dir) {
        $self->error(BADDIR => WARN => $dir);
    }
    elsif (not $self->{file}) {
        $self->error(NOFILE => 'WARN');
    }
    elsif (-f "$dir/$self->{file}" and not -w _) {
        $self->error(BADFILE => WARN => "$dir/$self->{file}");
    }
    elsif (not open FILE, "> $dir/$self->{file}") {
        $self->error(SAVEERROR => WARN => "$dir/$self->{file}", "$!");
    }
    else { # Everything is good, now we have FILE open to the file.
        $self->debug("Saving $dir/$self->{file}");
        my $headers;
        while (my ($key, $val) = each %{$self->{headers}}) {
            next unless $key and $val;
            $key =~ s/\r?\n//g; $val =~ s/\r?\n//g; # Just in case...
            $headers .= "$key: $val\n";
        }
        print FILE $headers;
        print FILE "" . "\n"; # Blank line
        $self->{body} =~ s/\r\n/\n/g;
        print FILE $self->{body};
        close FILE;
    }

    if (@{$self->{_error}}) {
        return { error => join("<br>\n", @{$self->{_error}}) };
    }
    else {
        return { success => 1, error => '' };
    }
}

# GT::Mail::Editor::tpl_load(header => To, header => From, header => Subject)
# In this case, "To", "From" and "Subject" will come to you as header_To,
# header_From, and header_Subject.
# What you get back is a hash reference, with either "error" set to an error
# if something bad happened, or "success" set to 1, and the following template
# variables:
#
# header_To, header_From, header_Subject, header_...
#               => The value of the To, From, Subject, etc. field.
#               -> Only present for individual headers that are requested with "header"
# extra_headers => A loop of all the other headers with { name => To, From, etc., value => value }
# body => The body of the e-mail. This will eventually change as this module
#      -> becomes capable of creating e-mails with multiple parts.
sub tpl_load {
    my $self = &_get_self;
    my %sep_headers;
    for (my $i = 0; $i < @_; $i++) {
        if (lc $_[$i] eq 'header') {
            $sep_headers{$_[++$i]} = 1;
        }
    }
    my $dir;
    if ($self->{dir} and $self->{template} and $self->{file}
        and $self->{template} !~ m[[\\/\x00-\x1f]] and $self->{template} ne '..'
        and $self->{file} !~ m[[\\/\x00-\x1f]]) {
        $dir = "$self->{dir}/$self->{template}";
        if (-f "$dir/local/$self->{file}") {
            $dir .= "/local";
        }
        elsif (!-f "$dir/$self->{file}") {
            my ($tplinfo, %tplinfo);
            while ($tplinfo = GT::Template->load_tplinfo($dir) and my $inherit = $tplinfo->{inheritance}) {
                if ($inherit =~ m!^(?:[a-zA-Z]:)?[\\/]!) { # Absolute inheritance path
                    $dir = $inherit;
                }
                else {
                    $dir .= "/$inherit";
                }
                if (-f "$dir/local/$self->{file}") {
                    $dir .= "/local";
                    last;
                }
                elsif (-f "$dir/$self->{file}") {
                    last;
                }
                if (length $dir > 150 or $tplinfo{$dir}++) { # We've already looked at that directory, or we just have too many relative paths tacked on the end
                    $self->error(RECURSION => WARN => $dir);
                    last; # End the loop - there is no more inheritance since we would just be recursing over what we already have
                }
            }
        }
    }

    my $fh = \do { local *FILE; *FILE };
    $self->{_error} = [];
    my $return = { success => 0, error => '' };
    if ($self->{template} =~ m[[\\/\x00-\x1f]] or $self->{template} eq '..') {
        $self->error(INVALIDDIR => WARN => $self->{template});
    }
    elsif ($self->{file} =~ m[[\\/\x00-\x1f]]) {
        $self->error(INVALIDTPL => WARN => $self->{file});
    }
    elsif (not $dir) {
        $self->error(NODIR => 'WARN');
    }
    elsif (not -d $dir) {
        $self->error(BADDIR => WARN => $dir);
    }
    elsif (not $self->{file}) {
        $self->error(NOFILE => 'WARN');
    }
    elsif (not -r "$dir/$self->{file}") {
        $self->error(BADFILE => WARN => "$dir/$self->{file}");
    }
    elsif (not open $fh, "< $dir/$self->{file}") {
        $self->error(LOADERROR => WARN => "$dir/$self->{file}");
    }
    else { # Everything is good, now we have $fh open to the file.
        $return->{success} = 1;
        $self->load($fh);
        while (my ($name, $val) = each %{$self->{headers}}) {
            if ($sep_headers{$name}) {
                $return->{"header_$name"} = $val;
            }
            else {
                push @{$return->{extra_headers}}, { name => $name, value => $val };
            }
        }
        $return->{body} = $self->{body};
    }
    if ($self->{_error}) {
        $return->{error} = join "<br>\n", @{$self->{_error}};
    }
    return $return;
}

sub tpl_delete {
    my $self = &_get_self;

    if ($self->{dir} and $self->{template} and $self->{file}
        and $self->{template} !~ m[[\\/\x00-\x1f]] and $self->{template} ne '..'
        and $self->{file} !~ m[[\\/\x00-\x1f]]) {
        my $tpl = "$self->{dir}/$self->{template}/local/$self->{file}";
        if (-f $tpl and not unlink $tpl) {
            return { error => "Unable to remove $tpl: $!" };
        }
    }
    return { success => 1, error => '' };
}

# Loads a template from a filehandle or a file.
# You must pass in a GLOB reference as a filehandle to be read from.
# Otherwise, this method will attempt to open the file passed in and then read from it.
# (the file opened will have directory and template prepended to it).
sub load {
    my $self = shift;
    my $fh;
    my $file = shift;
    if (ref $file eq 'GLOB' or ref $file eq 'SCALAR' or ref $file eq 'LVALUE') {
        $fh = $file;
    }
    else {
        $fh = \do { local *FILE; *FILE };
        my $dir;
        if ($self->{template}) {
            $dir = "$self->{dir}/$self->{template}";
            if (-f "$dir/local/$file") {
                $dir .= "/local";
            }
            elsif (!-f "$dir/$file") {
                my ($tplinfo, %tplinfo);
                while ($tplinfo = GT::Template->load_tplinfo($dir) and my $inherit = $tplinfo->{inheritance}) {
                    if ($inherit =~ m!^(?:[a-zA-Z]:)?[\\/]!) { # Absolute inheritance path
                        $dir = $inherit;
                    }
                    else {
                        $dir .= "/$inherit";
                    }
                    if (-f "$dir/local/$file") {
                        $dir .= "/local";
                        last;
                    }
                    elsif (-f "$dir/$file") {
                        last;
                    }
                    if (length $dir > 150 or $tplinfo{$dir}++) { # We've already looked at that directory, or we just have too many relative paths tacked on the end
                        $self->error(RECURSION => WARN => $dir);
                        last; # End the loop - there is no more inheritance since we would just be recursing over what we already have
                    }
                }
            }
        }
        $file = "$dir/$file";

        open $fh, "< $file" or return $self->error(BADFILE => WARN => $file);
    }
    if (ref $fh eq 'GLOB') {
        while (<$fh>) { # The header
            s/\r?\n$//;
            last if not $_; # An empty line is the end of the headers
            my ($field, $value) = split /:\s*/, $_, 2;
            $self->{headers}->{$field} = $value;
        }
        while (<$fh>) { # The body
            $self->{body} .= $_;
        }
    }
    else {
        (my $header, $self->{body}) = split /\r?\n\r?\n/, $$fh, 2;
        my @h = split /\r?\n/, $header;
        for (@h) {
            my ($field, $value) = split /:\s*/, $_, 2;
            $self->{headers}->{$field} = $value;
        }
    }
    return 1;
}

# Creates and returns a $self object. Looks at $_[0] to see if it is already
# an editor object, and if so uses that. Otherwise it calls new() with @_.
# Should be called as &_get_self; If called as a class method, the first
# argument will be removed. So, instead of: 'my $self = shift;' you should
# use: 'my $self = &_get_self;'
sub _get_self {
    my $self;
    if (ref $_[0] and substr(ref $_[0], -8) eq '::Editor') { # This will allow any subclass as long as it is something::Editor
        $self = shift;
    }
    elsif (@_ and substr($_[0], -8) eq '::Editor') { # Class methods
        my $class = shift;
        $self = $class->new(@_);
    }
    else {
        $self = __PACKAGE__->new(@_);
    }
    return $self;
}

sub init {
    my $self = shift;
    $self->set(@_);
    tie %{$self->{headers}}, __PACKAGE__ . '::Ordered';
}


package GT::Mail::Editor::Ordered;
# Implements a hash that retains the order elements are inserted into it.

sub TIEHASH { bless { o => [], h => {}, p => 0 }, $_[0] }

sub STORE {
    my ($self, $key, $val) = @_;
    $self->DELETE($key) if exists $self->{h}->{$key};
    $self->{h}->{$key} = $val;
    push @{$self->{o}}, $key;
}

sub FETCH { $_[0]->{h}->{$_[1]} }

sub FIRSTKEY {
    my $self = shift;
    $self->{p} = 0;
    $self->{o}->[$self->{p}++]
}

sub NEXTKEY { $_[0]->{o}->[$_[0]->{p}++] }

sub EXISTS { exists $_[0]->{h}->{$_[1]} }

sub DELETE {
    my ($self, $key) = @_;
    for (0 .. $#{$self->{o}}) {
        if ($self->{o}->[$_] eq $key) {
            splice @{$self->{o}}, $_, 1;
            last;
        }
    }
    delete $self->{h}->{$key};
}
sub CLEAR { $_[0] = { o => [], h => {}, p => 0 }; () }

1;

__END__

=head1 NAME

GT::Mail::Editor - E-mail template editor

=head1 SYNOPSIS

Generally used from templates:

    <%GT::Mail::Editor::tpl_load(
        dir => $template_root,
        template => $template_set,
        file => $filename,
        header => From,
        header => To,
        header => Subject
    )%>

    <%if error%>
        Unable to load e-mail template: <%error%>
    <%else%>
        From: <input type=text name=header_From value="<%header_From%>">
        To: <input type=text name=header_To value="<%header_To%>">
        Subject: <input type=text name=header_Subject value="<%header_Subject%>">
        Other headers:<br>
        <textarea name=extra_headers>
        <%loop extra_headers%><%name%>: <%value%>
        <%endloop%>
    <%endif%>


    - or -


    <%GT::Mail::Editor::save(
        dir => $template_root,
        template => $template_set,
        file => $filename,
        header => To => $header_To,
        header => From => $header_From,
        header => Subject => $header_Subject,
        extra_headers => $extra_headers
    )%>
    <%if error%>Unable to save e-mail template: <%error%>
        ... Display the above form in here ...
    <%endif%>

=head1 DESCRIPTION

GT::Mail::Editor is designed to provide a template interface to creating and
editing a wide variety of e-mail templates. Although not currently supported,
eventually attachments, HTML, etc. will be supported.

=head2 tpl_load - Loads a template (from the templates)

Calling GT::Mail::Editor::tpl_load from a template returns variables required to
display a form to edit the template passed in.

=over 4

=item dir

Defines the base directory of templates.

=item template

This defines a template set. This is optional. If present, this directory will
be tacked onto the end of 'dir'. This is simply to provide a more flexible way
to specify the template directory. For example, if you have 'dir' set to '/a/b'
and template set to 'c', then the directory '/a/b/c' will be used to save and
load e-mail templates.

=item file

Specify the filename of the template inside the directory already specified with
'dir' and 'template'

=item header

Multiple "special" headers can be requested with this. The argument following
each 'header' should be the name of a header, such as "To". Then, in the
variables returned from tpl_load(), you will have a variable such as 'header_To'
available, containing the value of the To: field.

=back

=head2 tpl_save - Save a template

=over 4

=item dir template file

See the entries in L<"tpl_load">

=item header

Specifies that the two following arguments are the field and value of a header
field. For example, header => To => "abc@example.com" would specify that the To
field should be "abc@example.com" (To: abc@example.com).

=item extra_headers

The value to extra_headers should be a newline-delimited list of headers other
than those specified with header. These will be parsed, and blank lines skipped.

=item body

The body of the message. Need I say more? MIME messages are possible by
inserting them directly into the body, however currently MIME messages cannot
be created using this editor.

=back

=head2 load

Attempts to load a GT::Mail::Editor object with data passed in. This can take
either a file handle or a filename. If passing a filename, dir and template
will be used (if available). You should construct an object with new() prior
to calling this method.

=head2 new

Constructs a new GT::Mail::Editor object. This will be done automatically when
using the template methods L<"tpl_load"> and L<"tpl_save">. Takes the following
arguments:

=over 4

=item dir

Defines the base directory of templates.

=item template

This defines a template set. This is optional. If present, this directory will
be tacked onto the end of 'dir'. This is simply to provide a more flexible way
to specify the template directory. For example, if you have 'dir' set to '/a/b'
and template set to 'c', then the directory '/a/b/c' will be used to save and
load e-mail templates.

=back

=head1 COPYRIGHT

Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
http://www.gossamer-threads.com/

=head1 VERSION

Revision: $Id: Editor.pm,v 1.25 2008/09/23 23:55:26 brewt Exp $