# ====================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Config
#   Author: Jason Rhinelander
#   $Id: Config.pm,v 1.24 2003/09/02 04:11:41 jagerman Exp $
#
# Copyright (c) 1999,2000 Gossamer Threads Inc.  All Rights Reserved.
# ====================================================================
#
# Description:
#   A module for handling loading and caching of configuration files.
#

package GT::Config;
# ===============================================================

use strict;

use GT::Base qw/$MOD_PERL/; # Due to the nature of the config file's hash-like interface, we can't inherit from GT::Base - it sets things in $self. We do need GT::Base for its in_eval function though.
use GT::Template::Inheritance;
use GT::AutoLoader;

use constants DATA        => 0,
              INHERITED   => 1,
              FILES       => 2,
              FILES_MTIME => 3,
              CODE_STR    => 4;

use vars qw(%ATT %ATTRIBS %CACHE %SUB_CACHE $error $ERRORS $VERSION);

# %ATT stores the default attribute values
# %ATTRIBS stores the attributes of each object. Since each object works exactly
#   like a hash ref of the data it represents, these attributes cannot be stored
#   in $self.
# %CACHE is used to cache any data of objects using the 'cache' option. Each
#   file in here has an array ref value - the first value is a hash ref of the
#   data, the second a hash ref of inherited keys, the third an array of the
#   files inherited from, and the fourth a hash of last modification times of
#   those files.
# %SUB_CACHE is exactly like %CACHE, except that values starting with 'sub {'
#   will be compiled into code refs. Each array ref has a fifth value - a hash
#   reference list that stores the original value of any code refs that have
#   been compiled. %SUB_CACHE is only used when you use 'compile_subs'. Also,
#   because different packages can be specified, this stores which package the
#   code ref was compiled in.
# $error stores any error that occurs. If a load error happens, you'll need to
#   use $error to get the error message (when not using the 'create_ok' option).
# $ERRORS stores all the error codes
# $VERSION - $Id: Config.pm,v 1.24 2003/09/02 04:11:41 jagerman Exp $ - The version.

$VERSION = sprintf "%d.%03d", q$Revision: 1.24 $ =~ /(\d+)\.(\d+)/;

%ATT = (
    inheritance => 0, # If set, looks for .tplinfo files for inheritance.
    local => 0, # If set, will look for "local" directories containing the file. The file will be saved in a "local" subdirectory of the directory given.
    cache => 1, # If set, the object (and hence configuration) will be stored in a hash. The next time you create a new object, GT::Config will look in the cache first.
    create_ok => 0, # If set, you'll get a GT::Config object even if the file doesn't exist. You can then save() it to create the file. If not set, a fatal error occurs if the file cannot be located. Note that if the file exists, but has a syntax error, or cannot be read, a fatal error will occur regardless of this option.
    strict => 0, # If true, a fatal error will occur when attempting to access a key that does not exist.
    debug => 0, # If true, warnings and debugging will be printing to STDERR
    header => '', # Can be set to anything. When saving, this will go before the data. Keep in mind, this has to be correct Perl. [localtime] in here will be replaced with scalar localtime() when saving.
    compile_subs => '', # Must be set to a package. If set, any value that starts with 'sub {' will be compiled into a code ref, in the package specified.
    tab => "\t", # What to use for a "tab" in the config file. Defaults to an actual tab.
);

# Other attributes used internally:
#   filename => '', # Whatever you give as the filename
#   file => '', # Just the filename (no path)
#   path => '', # The path of the filename
#   files => {}, # A hash of filename => last_mod_time (may contain multiple entries to support inheritance).
#   file_order => [], # The order of the files in 'files'
#   data => {}, # The actual data of the config file.
#   inherited => {}, # Each base key inherited will have $key => 1 in here. Inherited keys are not saved, unless they are changed between load time and save time.
#   compiled => {}, # Any keys that start with 'sub {' will be compiled into code refs if the compile_subs option is on. This saves the string 'sub {...'

$ERRORS = {
    CANT_LOAD         => q _Unable to load '%s': %s._,
    CANT_COMPILE      => q _Unable to compile '%s': %s._,
    CANT_FIND         => q _Config file '%s' does not exist in directory '%s' or has incorrect permissions set._,
    CANT_WRITE        => q _Unable to open '%s' for writing: %s._,
    CANT_PRINT        => q _Unable to write to file '%s': %s._,
    CANT_RENAME       => q _Unable to move '%s' to '%s': %s._,
    WRITE_MISMATCH    => q _Unable to save '%s': wrote %d bytes, but file is %d bytes_,
    CANT_CREATE_DIR   => q _Unable to create directory '%s': %s._,
    NOT_HASH          => q _Config file '%s' did not return a hash reference._,
    BAD_ARGS          => q _Bad arguments. Usage: %s_,
    NOT_FILE          => q _'%s' does not look like a valid filename_,
    RECURSION         => q _Recursive inheritance detected and interrupted: '%s'_,
    UNKNOWN_OPT       => q _Unknown option '%s' passed to %s_,
    BAD_KEY           => q _The key you attempted to access, '%s', does not exist in '%s'_,
    CANT_COMPILE_CODE => q _Unable to compile '%s' in file '%s': %s_
};

sub load {
    my $class = shift;

    my (%attribs, %data);

    tie %data, $class, \%attribs;
    my $self = bless \%data, ref $class || $class;

    $ATTRIBS{$self} = \%attribs; # hehehe ;-)

    my $filename = shift or return $self->error(BAD_ARGS => FATAL => 'GT::Config->load("/path/to/config/file", { opts })');
    $attribs{filename} = $filename;
    $attribs{filename_given} = $filename;

    @attribs{'path', 'file'} = ($filename =~ m|^(.*?)[\\/]?([^\\/]+)$|) or return $self->error(NOT_FILE => FATAL => $filename);
    $attribs{path} = '.' unless length $attribs{path};
    $filename = $attribs{filename} = "$attribs{path}/$attribs{file}"; # _load_data/_load_tree depend on it being like this.

    my $opts = shift || {};
    ref $opts eq 'HASH' or return $self->error(BAD_ARGS => FATAL => 'GT::Config->load("/path/to/config/file", { opts })');

    for (keys %ATT) {
        if (/^(?:inheritance|local|cache|create_ok|strict)$/) {
            $attribs{$_} = exists $opts->{$_} ? (delete $opts->{$_} ? 1 : 0) : $ATT{$_};
        }
        else {
            $attribs{$_} = exists $opts->{$_} ? delete $opts->{$_} : $ATT{$_};
        }
    }

    $self->debug("Received '$filename' for the file to load", 2) if $attribs{debug} >= 2;

    if (keys %$opts) {
        $self->error(UNKNOWN_OPT => FATAL => keys %$opts => ref($self) . '->load');
    }

    $self->debug("Loading '$filename' with options: inheritance => '$attribs{inheritance}', local => '$attribs{local}', cache => '$attribs{cache}', create_ok => '$attribs{create_ok}', strict => '$attribs{strict}', debug => '$attribs{debug}', compile_subs => '$attribs{compile_subs}'") if $attribs{debug};
    $self->debug("Header: '$attribs{header}'", 2) if $attribs{debug} >= 2;

    if ($attribs{cache} and $attribs{compile_subs} and $SUB_CACHE{$attribs{compile_subs}}->{$filename} and my $debug_unchanged = $self->_is_unchanged(@{$SUB_CACHE{$attribs{compile_subs}}->{$filename}}[FILES, FILES_MTIME])) {
        $self->debug("Loading '$filename' from compiled sub cache") if $attribs{debug};
        @attribs{qw{data inherited file_order files compiled}} = @{$SUB_CACHE{$attribs{compile_subs}}->{$filename}};
    }
    elsif ($attribs{cache} and not $attribs{compile_subs} and $CACHE{$filename} and $debug_unchanged = $self->_is_unchanged(@{$CACHE{$filename}}[FILES, FILES_MTIME])) {
        $self->debug("Loading '$filename' from regular cache") if $attribs{debug};
        @attribs{qw{data inherited file_order files}} = @{$CACHE{$filename}};
    }
    else {
        $self->debug("Not loading '$filename' from cache") if $attribs{debug};
        if ($attribs{debug} > 1) { # If the debug level is > 1, display some debugging as to _why_ we aren't loading from cache
            $self->debug("Reason: Caching disabled") if not $attribs{cache};
            if ($attribs{compile_subs} and not $SUB_CACHE{$attribs{compile_subs}}->{$filename}) { $self->debug("Reason: Not in compiled sub cache") }
            elsif (not $attribs{compile_subs} and not $CACHE{$filename}) { $self->debug("Reason: Not in regular cache") }
            $self->debug("Reason: File (or inherited files) have changed") if ($attribs{compile_subs} ? $SUB_CACHE{$attribs{compile_subs}}->{$filename} : $CACHE{$filename}) and not $debug_unchanged;
        }
        $self->_load_data($filename) or return;
        if ($attribs{cache} and @{$attribs{file_order}}) { # Don't cache it if it is a new object
            if ($attribs{compile_subs}) {
                $self->debug("Adding '$filename' (compile package '$attribs{compile_subs}') to the compiled sub cache") if $attribs{debug};
                $SUB_CACHE{$attribs{compile_subs}}->{$filename} = [@attribs{qw{data inherited file_order files compiled}}];
            }
            else {
                $self->debug("Adding '$filename' to the regular cache") if $attribs{debug};
                $CACHE{$filename} = [@attribs{qw{data inherited file_order files}}];
            }
        }
    }
    return $self;
}

$COMPILE{save} = __LINE__ . <<'END_OF_SUB';
sub save {
    require GT::Dumper;
    my $self = shift;
    my $att = $ATTRIBS{$self};

    my ($d, $i, $c) = @$att{'data', 'inherited', 'compiled'};

    my %data;
    for (keys %$d) { # Strip out all inherited data
        next if $i->{$_};

        if ($att->{compile_subs} and ref $d->{$_} eq 'CODE' and exists $c->{$_}) {
            $data{$_} = $c->{$_};
        }
        else {
            $data{$_} = $d->{$_};
        }
    }

    my $filename = $att->{path};

    if ($att->{local}) {
        $filename .= "/local";
        if (!-d $filename) { # $filename is misleading - it's currently a path
            # Attempt to create the "local" directory
            mkdir($filename, 0777) or return $self->error(CANT_CREATE_DIR => FATAL => $filename => "$!");
            chmod(0777, $filename);
        }
    }

    $filename .= "/$att->{file}";

    $self->debug("Saving '$filename'") if $att->{debug};

    my $localtime = scalar localtime;
    my $header = $att->{header};
    if ($header) {
        $header =~ s/\[localtime\]/$localtime/g;
        $header .= "\n" unless $header =~ /\n$/;
    }

    my $tmp_filename = "$filename.tmp.$$";
    my $printed = 0;
    my $windows = $^O eq 'MSWin32';

    local *FILE;
    open FILE, "> $tmp_filename" or return $self->error(CANT_WRITE => FATAL => "$tmp_filename" => "$!");
# Print header, if any:
    if ($header) {
        $printed += length $header;
        $printed += $header =~ y/\n// if $windows; # Windows does \n => \r\n translation on FH output
        unless (print FILE $header) {
            my $err = "$!";
            close FILE;
            unlink $tmp_filename;
            return $self->error(CANT_PRINT => FATAL => $tmp_filename => $err);
        }
    }
# Print actual data:
    my $dump = GT::Dumper->dump(var => '', data => \%data, sort => 1, tab => $att->{tab});
    $printed += length $dump;
    $printed += $dump =~ y/\n// if $windows;
    unless (print FILE $dump) {
        my $err = "$!";
        close FILE;
        unlink $tmp_filename;
        return $self->error(CANT_PRINT => FATAL => $tmp_filename => $err);
    }
# Print the vim info line at the bottom:
    my $viminfo = "\n# vim:syn=perl:ts=4:noet\n";
    $printed += length $viminfo;
    $printed += $viminfo =~ y/\n// if $windows;
    unless (print FILE $viminfo) {
        my $err = "$!";
        close FILE;
        unlink $tmp_filename;
        return $self->error(CANT_PRINT => FATAL => $tmp_filename => $err);
    }
    close FILE;

# Check that the file is the right size, because print() returns true if a
# _partial_ print succeeded.  Ideally we would check -s on the filehandle after
# each print, but of course that doesn't work on Windows.
    unless ((my $actual = -s $tmp_filename) == $printed) {
        unlink $tmp_filename;
        return $self->error(WRITE_MISMATCH => FATAL => $tmp_filename => $printed => $actual);
    }

    $self->debug("'$tmp_filename' saved; renaming to '$filename'") if $att->{debug} > 1;
    unless (rename $tmp_filename, $filename) {
        my $err = "$!";
        unlink $tmp_filename;
        return $self->error(CANT_RENAME => FATAL => $tmp_filename => $filename => $err);
    }

    $self->debug("'$filename' saved.") if $att->{debug};
    return 1;
}
END_OF_SUB

sub _is_unchanged {
    my ($self, $old_order, $old_mtime) = @_;
    my $att = $ATTRIBS{$self};
    $self->debug("Checking for any changes in the file (or inherited files)") if $att->{debug};

    my @old_order = @$old_order; # Copy the old file_order and file modification
    my %old_mtime = %$old_mtime; # times. _load_tree will replace them.

    my $just_do_ok = not ($MOD_PERL or $att->{inheritance} or $att->{local} or $att->{create_ok});

    $self->_load_tree($just_do_ok);

    if (@{$att->{file_order}} != @old_order) {
        $self->debug("The old order and the new differ: Old: (@old_order) New: (@{$att->{file_order}})") if $att->{debug};
        return;
    }
    for (0 .. $#old_order) {
        if ($old_order[$_] ne $att->{file_order}->[$_]) {
            $self->debug("The old order and the new differ: Old: (@old_order) New: (@{$att->{file_order}})") if $att->{debug};
            return; # The inherited files are not the same as before
        }
        elsif ($att->{debug} >= 2) {
            $self->debug("Old order and new order do not differ. Old: (@old_order) New: (@{$att->{file_order}})");
        }

        if ($old_mtime{$old_order[$_]} != $att->{files}->{$old_order[$_]}) {
            $self->debug("The modification time of $old_order[$_] has changed: Old: $old_mtime{$old_order[$_]}, New: $att->{files}->{$old_order[$_]}") if $att->{debug};
            return; # The inherited files have changed
        }
        elsif ($att->{debug} >= 2) {
            $self->debug("The modification time of $old_order[$_] has not changed: Old: $old_mtime{$old_order[$_]}, New: $att->{files}->{$old_order[$_]}");
        }
    }

    $self->debug("No changes have been made") if $att->{debug};
    1; # Here's the prize. Nothing is changed.
}

sub _load_data {
    my $self = shift;
    my $att = $ATTRIBS{$self};

    my $just_do_ok = not ($MOD_PERL or $att->{inheritance} or $att->{local} or $att->{create_ok});

    $self->_load_tree($just_do_ok) or return;

    if ($just_do_ok and not @{$att->{file_order}}) {
        push @{$att->{file_order}}, $att->{filename_given};
    }

    for my $file (@{$att->{file_order}}) {
        local ($@, $!, $^W);
        $self->debug("do()ing '$file'") if $att->{debug} >= 2;
        my $data = do $file;
        if (!$data and $!) {
            return $self->error(CANT_LOAD => FATAL => $file => "$!");
        }
        elsif (!$data and $@) {
            return $self->error(CANT_COMPILE => FATAL => $file => "$@");
        }
        elsif (ref $data ne 'HASH') {
            return $self->error(NOT_HASH => FATAL => $file);
        }
        if ($just_do_ok or $file eq ($att->{local} ? "$att->{path}/local/$att->{file}" : $att->{filename})) {
            $att->{data} = $data;
        }
        else {
            for (keys %$data) {
                next if exists $att->{data}->{$_};
                $att->{data}->{$_} = $data->{$_};
                $att->{inherited}->{$_} = 1;
            }
        }
    }

    1; # Returning true means loading was successful.
}

sub _load_tree {
    my $self = shift;
    my $just_do_ok = shift;
    my $att = $ATTRIBS{$self};

    my $root = $att->{path};
    my $file = $att->{file};

    if ($att->{inheritance}) {
        $att->{file_order} = [GT::Template::Inheritance->get_all_paths(file => $att->{file}, path => $att->{path})];

        unless (@{$att->{file_order}} or $att->{create_ok} or $just_do_ok) {
            return $self->error('CANT_FIND' => 'FATAL', $att->{file}, $att->{path});
            # No files found!
        }

        for (@{$att->{file_order}}) {
            $att->{files}->{$_} = (stat($_))[9];
        }
    }
    else {
        if (-e "$root/$file") {
            $att->{file_order} = ["$root/$file"];
            $att->{files}->{"$root/$file"} = (stat("$root/$file"))[9];
        }
        elsif ($att->{create_ok} or $just_do_ok) {
            $att->{file_order} = [];
        }
        else {
            return $self->error(CANT_FIND => FATAL => $att->{file}, $att->{path});
        }
    }

    1;
}

$COMPILE{inheritance} = __LINE__ . <<'END_OF_SUB';
sub inheritance {
    my $self = shift;
    my $att = $ATTRIBS{$self};
    if (@_) {
        my $ret = $att->{inheritance} ? 1 : 0;
        $att->{inheritance} = shift() ? 1 : 0;
        return $ret;
    }
    $att->{inheritance};
}
END_OF_SUB

# Must be specified in load() - this only retrieves the value
$COMPILE{create_ok} = __LINE__ . <<'END_OF_SUB';
sub create_ok {
    my $self = shift;
    my $att = $ATTRIBS{$self};
    $att->{create_ok};
}
END_OF_SUB

# Must be specified in load()
$COMPILE{cache} = __LINE__ . <<'END_OF_SUB';
sub cache {
    my $self = shift;
    my $att = $ATTRIBS{$self};
    $att->{cache};
}
END_OF_SUB

$COMPILE{strict} = __LINE__ . <<'END_OF_SUB';
sub strict {
    my $self = shift;
    my $att = $ATTRIBS{$self};
    if (@_) {
        my $ret = $att->{strict} ? 1 : 0;
        $att->{strict} = shift() ? 1 : 0;
        return $ret;
    }
    $att->{strict};
}
END_OF_SUB

$COMPILE{debug_level} = __LINE__ . <<'END_OF_SUB';
sub debug_level {
    my $self = shift;
    my $att = $ATTRIBS{$self};
    if (@_) {
        my $ret = $att->{debug};
        $att->{debug} = shift;
        return $ret;
    }
    $att->{debug};
}
END_OF_SUB

$COMPILE{debug} = __LINE__ . <<'END_OF_SUB';
sub debug {
# -------------------------------------------------------
# Displays a debugging message.
#
    my ($self, $msg, $min) = @_;
    my $att = $ATTRIBS{$self};

    $min ||= 1;
    return if $att->{debug} < $min;

    my $pkg = ref $self || $self;

# Add line numbers if no \n on the debug message
    if (substr($msg, -1) ne "\n") {
        my ($file, $line) = (caller)[1,2];
        $msg .= " at $file line $line.\n";
    }

# Remove windows linefeeds (breaks unix terminals).
    $msg =~ s/\r//g unless $^O eq 'MSWin32';

    print STDERR "$pkg ($$): $msg";
}
END_OF_SUB

$COMPILE{header} = __LINE__ . <<'END_OF_SUB';
sub header {
    my $self = shift;
    my $att = $ATTRIBS{$self};
    if (@_) {
        my $ret = $att->{header};
        $att->{header} = shift || '';
        return $ret;
    }
    $att->{header};
}
END_OF_SUB

# Be sure to delete the object from %ATTRIBS.
sub DESTROY {
    delete $ATTRIBS{$_[0]} if keys %ATTRIBS and exists $ATTRIBS{$_[0]};
}

$COMPILE{error} = __LINE__ . <<'END_OF_SUB';
sub error {
    my ($self, $code, $type, @args) = @_;
    $type = $type && uc $type eq 'WARN' ? 'WARN' : 'FATAL';
    my $pkg = ref $self || $self;

    $error = _format_err($pkg, $code, @args);

    if ($type eq 'FATAL') {
        die $error if GT::Base::in_eval();

        if ($SIG{__DIE__}) {
            die $error;
        }
        else {
            print STDERR $error;
            die "\n";
        }
    }
    elsif ($ATTRIBS{$self}->{debug}) { # A warning, and debugging is on
        if ($SIG{__WARN__}) {
            CORE::warn $error;
        }
        else {
            print STDERR $error;
        }
    }
    return;
}
END_OF_SUB

sub _format_err {
# -------------------------------------------------------
# Formats an error message for output.
#
    my ($pkg, $code, @args) = @_;
    my $msg = sprintf($ERRORS->{$code} || $code, @args);

    my ($file, $line) = GT::Base::get_file_line($pkg);
    return "$pkg ($$): $msg at $file line $line.\n";
}

# Tied hash handling
sub TIEHASH  { bless $_[1], $_[0] }
sub STORE    { $_[0]->{data}->{$_[1]} = $_[2]; delete $_[0]->{inherited}->{$_[1]} }
sub FETCH    {
    my $att = shift; # $_[0] is NOT $self - it is the attribute hashref
    my $key = shift;

    if ($att->{strict} and not exists $att->{data}->{$key}) {
        return GT::Config->error(BAD_KEY => FATAL => $key, $att->{filename});
    }
    elsif ($att->{compile_subs} and not ref $att->{data}->{$key} and substr($att->{data}->{$key}, 0, 5) eq 'sub {') {
        my $code = eval "package $att->{compile_subs}; $att->{data}->{$key}";
        if (ref $code ne 'CODE') {
            GT::Config->error(CANT_COMPILE_CODE => WARN => $key, $att->{filename}, "$@");
            my $error = "Unable to compile '$key': $@";
            $code = sub { $error };
        }

        $att->{compiled}->{$key} = delete $att->{data}->{$key};
        $att->{data}->{$key} = $code;
    }

    $att->{data}->{$key};
}
sub FIRSTKEY { scalar keys %{$_[0]->{data}}; each %{$_[0]->{data}} }
sub NEXTKEY  { each %{$_[0]->{data}} }
sub EXISTS   { exists $_[0]->{data}->{$_[1]} }
sub DELETE   { delete $_[0]->{inherited}->{$_[1]}; delete $_[0]->{data}->{$_[1]} }
sub CLEAR    { %{$_[0]->{data}} = (); %{$_[0]->{inherited}} = () }

1;

__END__

=head1 NAME

GT::Config - Dumped-hash configuration handler

=head1 SYNOPSIS

    use GT::Config;
    my $Config = GT::Config->load($config_file);
    ...
    print $Config->{variable};

=head1 DESCRIPTION

GT::Config provides a simple way to handle loading config files. It can load and
save any config file consisting of a dumped hash. You can then use the object as
if it were the actual hashref in the config file. It supports template set
inheritance (See L<GT::Template>) and timestamp-checking caching.

=head1 METHODS

=head2 load

There is no sub new. To get a new config object you do:

    $Config = GT::Config->load("/path/to/config/file", { options });

The first argument is the full path to the file to open to read the
configuration. The file does not necessarily have to exist - see the options
below.

The options you can pass in via the second argument hash reference are:

=over 4

=item inheritance

If provided as something true, GT::Config will scan for .tplinfo files looking
for inherited template sets. This is primary used for globals.txt or
language.txt files.

Defaults to not scan for inherited directories.

=item cache

If provided, will look in the cache for a cached copy of this file. If none is
found, a new GT::Config object will be constructed as usual, then saved in the
cache.

Defaults to caching. You must pass C<cache =E<gt> 0> to not cache.

=item create_ok

If set, you'll get back a GT::Config hash of the file doesn't exist. You can
then save() the object to create a new config file. If this option is not set,
a fatal error will occur when attempting to load a file that does not exist.

Defaults to off. Pass in C<create_ok =E<gt> 1> if the config file doesn't
necessarily have to exist.

=item strict

If set, a fatal error will occur when attempting to access a key of the config
file that does not exist. Note, however, that this only covers the first level
data structions - C<$CFG-E<gt>{foo}-E<gt>{bar}> will not fatal if C<foo> is a
hash ref, but C<bar> is not set in that hash reference. C<$CFG-E<gt>{foo}> (and
C<$CFG-E<gt>{foo}-E<gt>{bar}>) will fatal if the key C<foo> does not exist in
the config data.

=item debug

If provided, debugging information will be printed. This will also cause a
warning to occur if L<"fatal"> is disabled and load fails.

Defaults to disabled. Should not be used for production code.

=item header

If provided, when saving a file, this header will be written above the data.
Keep in mind that the file must be Perl-compilable, so be careful if you are
doing anything more than comments.

=item tab

If provided, this will set what to use for tabs when calling save(). Defaults
to an actual tab, since that cuts down the file size.

=item compile_subs

If provided, any data starting with C<sub {> will be compiled into a subroutine.
This compilation does not happen until the first time the variable is accessed,
at which point a fatal error will occur if the code could not be compiled. The
code referenced will be cached (if using caching), but will be saved as the
original string (starting with C<sub {>) when L<saving|"save">.

B<NOTE:> The argument to compile_subs must be a valid perl package; the code
reference will be compiled in that package. For example,
C<compile_subs =E<gt> 'GForum::Post'> will compile the code ref in the
GForum::Post package. You need to do this to provide access to globals variables
such as $DB, $IN, etc.

=back

=head2 save

To save a config file, simply call C<$object-E<gt>save()>. If the object uses
inheritance, only those keys that were not inherited (or were modified from the
inherited ones) will be saved.

    $Config->save();

B<NOTE>: B<ALWAYS SAVE AFTER MAKING ANY CHANGES!!!>. If you do not save after
making changes, the data retrieved from the cache may not be the same as the
data stored in the configuration file on disk. After making ANY changes make
absolutely sure that you either undo the change or save the configuration file.

=head2 inheritance

With no arguments, returns the inheritance status (1 or 0) of the object.

If you pass an argument, it turns on or off inheritance (depending on whether
you passed a true or false value, repectively), and returns whatever inheritance
I<WAS>. So, if inheritance is off, and you call C<$obj-E<gt>inheritance(1)>,
you'll get back C<0>.

=head2 create_ok

Returns the status of the "create_ok" flag.

Takes no arguments. Since this option only applies when loading, it has to be
provided as an option to C<load()>.

=head2 cache

This method returns whether or not the object is cached. This cannot be
enabled/disabled after loading a config file; you must specify it as an argument
to C<load()> instead.

=head2 debug_level

This method returns the current debug level.

You may provide one argument which sets a new debug level.

0 means no debugging, 1 means basic debugging, 2 means heavy debugging.

If providing a new debug level, the old debug level is returned.

=head2 header

This method returns or sets the header that will be printed when saving.

With no arguments, returns the header.

You may provide one argument which sets a new header. Keep in mine that the file
must be Perl-compilable, so take care if doing anything other than comments.

If providing a new header, the old header is returned.

Note that the header may contains C<[localtime]>, which will be replaced with
the return value of C<scalar localtime()> when saving.

=head1 SEE ALSO

L<GT::Template::Inheritance>

=head1 MAINTAINER

Jason Rhinelander

=head1 COPYRIGHT

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

=head1 VERSION

$Id: Config.pm,v 1.24 2003/09/02 04:11:41 jagerman Exp $

=cut