# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Plugins
#   Author  : Alex Krohn
#   CVS Info :                          
#   $Id: Wizard.pm,v 1.34 2005/04/14 07:43:48 brewt Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description: A web based admin to install/uninstall/edit plugins.
#

package GT::Plugins::Wizard;
# ==================================================================
use strict;
use vars qw/@ISA $ATTRIBS $ERROR_MESSAGE $VERSION $DEBUG/;
use GT::Base;
use GT::Plugins;
use GT::Tar;
use GT::Dumper;

$ERROR_MESSAGE = 'GT::Plugins';
$DEBUG   = 0;
$VERSION = sprintf "%d.%03d", q$Revision: 1.34 $ =~ /(\d+)\.(\d+)/;
$ATTRIBS = {
    prefix         => '',
    cgi            => undef,
    initial_indent => '    ',
    tpl_root       => '.',
    tpl_prefix     => '',
    plugin_dir     => undef,
    plugin         => undef,
    tar            => undef,
    prog_ver       => undef,
    install_header => undef,
    dirs           => {},
    oo             => undef
};
@ISA = qw/GT::Base/;

sub process {
# ----------------------------------------------------------------
# Determines what to do based on cgi input, and return a hash
# content => data for printing by outside application.
#
    my $self = shift;
    ref $self->{cgi} and UNIVERSAL::can($self->{cgi}, 'param') or return $self->error('BADARGS', 'FATAL', "no cgi object passed to wizard");
    defined $self->{plugin_dir} and -d $self->{plugin_dir}     or return $self->error('BADARGS', 'FATAL', "missing/invalid plugin dir passed to wizard");

# Figure out what to do.
    my $action = $self->{cgi}->param('plugin_wiz_do') || '';
    my $vars   = {};
    my $page   = 'plugin_wizard_step1.html';
    my $plugin = $self->{cgi}->param('plugin_name');
    $self->load_plugin($plugin) if ($plugin);

    CASE: {
# Meta Information
        ($action eq 'step2') and do {
            $vars = $self->_validate_step1();
            if (defined $vars->{error}) { $page = 'plugin_wizard_step1.html'; last CASE }
            $vars = $self->_load_step2();
            $page = 'plugin_wizard_step2.html';
            last CASE;
        };
# Plugin Hooks
        ($action eq 'step3') and do {
            $vars = $self->_validate_step2() unless ($self->{cgi}->param('skip_validate'));
            if (defined $vars->{error})   { $page = 'plugin_wizard_step2.html'; last CASE }
            $vars = $self->_load_step3();
            $page = 'plugin_wizard_step3.html';
            last CASE;
        };
# Admin Menu Options.
        ($action eq 'step4') and do {
            $vars = $self->_validate_step3();
            if (defined $vars->{error})   { $page = 'plugin_wizard_step3.html'; last CASE }
            if (defined $vars->{results}) { $page = 'plugin_wizard_step3.html'; last CASE }
            $vars = $self->_load_step4();
            $page = 'plugin_wizard_step4.html';
            last CASE;
        };
# User Options.
        ($action eq 'step5') and do {
            $vars = $self->_validate_step4();
            if (defined $vars->{error})   { $page = 'plugin_wizard_step4.html'; last CASE }
            if (defined $vars->{results}) { $page = 'plugin_wizard_step4.html'; last CASE }
            $vars = $self->_load_step5();
            $page = 'plugin_wizard_step5.html';
            last CASE;
        };
# Included Files.
        ($action eq 'step6') and do {
            $vars = $self->_validate_step5();
            if (defined $vars->{error})   { $page = 'plugin_wizard_step5.html'; last CASE }
            if (defined $vars->{results}) { $page = 'plugin_wizard_step5.html'; last CASE }
            $vars = $self->_load_step6();
            $page = 'plugin_wizard_step6.html';
            last CASE;
        };
# All Done.
        ($action eq 'step7') and do {
            $vars = $self->_validate_step6();
            if (defined $vars->{error})   { $page = 'plugin_wizard_step6.html'; last CASE }
            if (defined $vars->{results}) { $page = 'plugin_wizard_step6.html'; last CASE }
            $vars = $self->_load_step7();
            $page = 'plugin_wizard_step7.html';
            last CASE;
        };
# Create the plugin and finish.
        ($action eq 'create') and do {
            $vars = $self->_validate_step7();
            if (defined $vars->{error})   { $page = 'plugin_wizard_step7.html'; last CASE }
            if (defined $vars->{results}) { $page = 'plugin_wizard_step7.html'; last CASE }
            $vars = $self->_create_install();
            if (defined $vars->{error})   { $page = 'plugin_wizard_step7.html'; last CASE }
            if (defined $vars->{results}) { $page = 'plugin_wizard_step7.html'; last CASE }
            $vars = $self->_create_code();
            if (defined $vars->{error})   { $page = 'plugin_wizard_step7.html'; last CASE }
            if (defined $vars->{results}) { $page = 'plugin_wizard_step7.html'; last CASE }
            $page = 'plugin_wizard_step8.html';
            last CASE;
        };

# Get a list of plugins that can be edited.
        $vars->{edit} = $self->_list_editable;
    }

    return $self->page($page, $vars);
}

sub page {
# ----------------------------------------------------------------
# Returns a content => parsed_page hash ref.
#
    my ($self, $page, $vars) = @_;
    my $cgi     = $self->{cgi}->get_hash;
    for my $key (keys %$cgi) { exists $vars->{$key} or $vars->{$key} = $cgi->{$key}; }
    my $contents = GT::Template->parse(
        $self->{tpl_prefix} . $page,
        $vars,
        { root => $self->{tpl_root} }
    ) or return;
    return { content => \$contents };
}

sub load_plugin {
# ----------------------------------------------------------------
# Loads a plugin.
#
    my ($self, $plugin_name) = @_;
    $self->{plugin}->{name} = $plugin_name;
    return unless (defined $plugin_name and $plugin_name =~ /^\w{2,20}$/);

    $self->{tar} = $self->_load_tar;
    $self->_load_plugin;
    return 1;
}

sub save_plugin {
# -------------------------------------------------------------------
# Saves the plugin back to disk.
#
    my $self = shift;
    my $wizard = $self->{tar}->get_file('Wizard.pm');
    if (! $wizard) {
        $self->{tar}->add_data(name => 'Wizard.pm', body => $self->_create_wizard);
    }
    else {
        $wizard->body($self->_create_wizard);
    }
    return $self->{tar}->write;
}

sub _get_hook_params {
# ------------------------------------------------------------------------------
    my $hook  = shift;
    my $param = shift;
    my %results;
    for my $e (@$hook) {
        my $val = ref $e->{$param} ? join(", ", @{$e->{$param}}) : $e->{$param};
        $results{$val}++;
    }
    return sort keys %results;
}

sub _validate_step1 {
# -------------------------------------------------------------------
# Checks that the plugin name is valid.
#
    my $self = shift;
    my $name = $self->{cgi}->param('plugin_name');
    $name or return { error => "Please enter a valid plugin name." };
    $name =~ /^\w{2,20}$/ or return {
        error => "Plugin names must be only letters and numbers, and be between 2 and 20 characters."
    };
    $self->save_plugin    or return { error => $GT::Plugins::error };
    return { plugin_name => $name };
}

sub _load_step2 {
# -------------------------------------------------------------------
# Preloads vars for meta information.
#
    my $self = shift;
    return defined $self->{plugin}->{meta}->{prog_ver}
        ? $self->{plugin}->{meta}
        : { %{$self->{plugin}->{meta}}, prog_ver => $self->{prog_ver} };
}

sub _validate_step2 {
# -------------------------------------------------------------------
# Validates the meta information.
#
    my $self = shift;
    my $version = $self->{cgi}->param('version');
    $version or return { error => "Please make sure you enter a version, perhaps start with 0.0.1 to begin." };
    $version =~ /^[\d\.]+$/ or return { error => "Version numbers should contain only numbers and periods." };

    my $author = $self->{cgi}->param('author');
    $author or return { error => "Please make sure you enter an author." };

    my $url = $self->{cgi}->param('url');

    my $license = $self->{cgi}->param('license');
    $license or return { error => "Please make sure you enter in a license style." };

    my $prog_ver = $self->{cgi}->param('prog_ver');
    $prog_ver or return {
        error => 'Please enter a program version that your plugin will require. Set to 1 for all versions.  ' .
            'This is useful to ensure the plugin user has the required version before using the plugin.'
    };

    my $description = $self->{cgi}->param('description');

    $self->{plugin}->{meta} = {
        version     => $version,
        author      => $author,
        url         => $url,
        license     => $license,
        description => $description,
        prog_ver    => $prog_ver
    };

    $self->save_plugin or return { error => $GT::Plugins::error };

    return {};
}

sub _load_step3 {
# -------------------------------------------------------------------
# Preloads vars for hook information.
#
    my $self = shift;
    my $font = 'font face="Tahoma,Arial,Helvetica" size="2"';

# try to load the hook config file
    return { hooks => '' } unless defined $self->{plugin}->{hooks} and @{$self->{plugin}->{hooks}};

    my $output = qq~
<table border=1 width="100%" cellpadding=3 bordercolor="#C0C0C0" cellspacing=0><tr>
    <td><b><$font>Hook</font></b></td>
    <td><b><$font>Type</font></b></td>
    <td><b><$font>Code</font></b></td>
    <td><b><$font>Position</font></b></td>
  </tr>~;

    for my $hook (@{$self->{plugin}->{hooks}}) {
        my $id = join("|", @$hook);
        my ($name, $type, $code, $position) = @$hook;
        $output .= qq~
  <tr>
    <td><$font><input type="checkbox" name="delete" value="$id"> $name</font></td>
    <td><$font>$type</font></td>
    <td><$font>$code</font></td>
    <td><$font>$position</font></td>
  </tr>~;
    }
    $output .= qq~
</table>
    ~;
    return { hooks => $output };
}

sub _validate_step3 {
# -------------------------------------------------------------------
# Validate any new hooks that were added.
#
    my $self = shift;
    $self->{plugin}->{hooks} ||= [];

# Remove unwanted hooks.
    my $results = '';
    if ($self->{cgi}->param('delete_btn')) {
        my @to_delete = $self->{cgi}->param('delete');
        for my $del_id (@to_delete) {
            my $i = 0;
            for my $hook (@{$self->{plugin}->{hooks}}) {
                my $id = join("|", @$hook);
                if ($id eq $del_id) {
                    $results .= "<li>Plugin hook " . $hook->[0] . " successfully removed.";
                    splice @{$self->{plugin}->{hooks}}, $i, 1;
                }
                $i++;
            }
        }
    }
# Add new hooks
    my $add_hook = $self->{cgi}->param('name');
    if ($add_hook) {
        my $add_code = $self->{cgi}->param('code');
        my $add_type = $self->{cgi}->param('type');
        my $add_pos  = $self->{cgi}->param('pos'); # Not used; future use?
        push @{$self->{plugin}->{hooks}}, [$add_hook, $add_type, $add_code, $add_pos];
        $results .= "<li>Plugin hook $add_hook successfully added.";
    }
    my $hooks = $self->_load_step3;
    if (! $results and $self->{cgi}->param('add_btn')) {
        return { error => "Please fill out the add form completely.", hooks => $hooks->{hooks} };
    }
    if (! $results and $self->{cgi}->param('delete_btn')) {
        return { error => "Please select one or more hooks to delete.", hooks => $hooks->{hooks} };
    }
    $self->save_plugin or return { error => $GT::Plugins::error };
    if ($results) {
        return { results => $results, hooks => $hooks->{hooks} };
    }
    return {};
}

sub _load_step4 {
# -------------------------------------------------------------------
# Preloads vars for admin menu options.
#
    my $self = shift;
    return { menu => '' } unless $self->{plugin}->{menu} and @{$self->{plugin}->{menu}};
    my $font   = 'font face="Tahoma,Arial,Helvetica" size="2"';
    my $output = qq~
<table border=1 width="100%" cellpadding=3 bordercolor="#C0C0C0" cellspacing=0><tr>
    <td><b><$font>Name</font></b></td>
    <td><b><$font>URL</font></b></td>
    </tr>~;

    for my $menu (@{$self->{plugin}->{menu}}) {
        my ($name, $url) = @$menu;
        $output .= qq~
<tr>
    <td><$font><input type="checkbox" name="delete" value="$name"> $name</font></td>
    <td><$font><a href="$url" target="_blank">$url</a></font></td>
    </tr>~;
    }
    $output .= qq~
</table>
    ~;
    return { menu => $output };
}

sub _validate_step4 {
# -------------------------------------------------------------------
# Validate any new menu that were added.
#
    my $self = shift;
    $self->{plugin}->{menu} ||= [];

# Remove unwanted menu.
    my $results = '';
    if ($self->{cgi}->param('delete_btn')) {
        my @to_delete = $self->{cgi}->param('delete');
        for my $del_id (@to_delete) {
            my $i = 0;
            for my $menu (@{$self->{plugin}->{menu}}) {
                my ($name, $url) = @$menu;
                if ($name eq $del_id) {
                    splice @{$self->{plugin}->{menu}}, $i, 1;
                    $results .= "<li>Menu Option " . $name . " successfully removed.";
                }
                $i++;
            }
        }
    }

# Add new menu
    my $add_name = $self->{cgi}->param('name');
    if ($add_name) {
        my $add_url  = $self->{cgi}->param('url');
        $self->{plugin}->{menu} ||= [];
        push @{$self->{plugin}->{menu}}, [$add_name, $add_url];
        $results .= "<li>Menu Option $add_name successfully added.";
    }

    my $menu = $self->_load_step4;
    if (! $results and $self->{cgi}->param('add_btn')) {
        return { error => "Please fill out the add form completely.", menu => $menu->{menu} };
    }
    if (! $results and $self->{cgi}->param('delete_btn')) {
        return { error => "Please select one or more admin menu to delete.", menu => $menu->{menu} };
    }

    $self->save_plugin or return { error => $GT::Plugins::error };
    if ($results) {
        return { results => $results, menu => $menu->{menu} };
    }
    return {};
}

sub _load_step5 {
# -------------------------------------------------------------------
# Preloads vars for user options.
#
    my $self = shift;
    return { user => '' } unless (defined $self->{plugin}->{user} and @{$self->{plugin}->{user}});
    my $font   = 'font face="Tahoma,Arial,Helvetica" size="2"';
    my $output = qq~
    <table border=1 width="100%" cellpadding=3 bordercolor="#C0C0C0" cellspacing=0><tr>
        <td><b><$font>Name</font></b></td>
        <td><b><$font>Value</font></b></td>
        <td><b><$font>Instructions</font></b></td>
        <td><b><$font>Form Type</font></b></td>
        <td><b><$font>Form Names</font></b></td>
        <td><b><$font>Form Value</font></b></td>
      </tr>~;

    for my $opt (@{$self->{plugin}->{user}}) {
        my ($name, $val, $instructions, $form_type, $form_names, $form_values ) = @$opt;
        $form_values = @$form_values
            ? "<ul>" . join("", map { "<li>" . $self->{cgi}->html_escape($_) . "</li>" } @$form_values) . "</ul>"
            : "&nbsp;";
        $form_names  = @$form_names
            ? "<ul>" . join("", map { "<li>" . $self->{cgi}->html_escape($_) . "</li>" } @$form_names) . "</ul>"
            : "&nbsp;";
        my $ins = $self->{cgi}->html_escape($instructions);
        $val = $self->{cgi}->html_escape($val);
        $output .= qq~
      <tr>
        <td valign="top"><$font><input type="checkbox" name="delete" value="$name"> $name</font></td>
        <td valign="top"><$font>$val</font></td>
        <td valign="top"><$font>$ins&nbsp;</font></td>
        <td valign="top"><$font>$form_type</font></td>
        <td valign="top"><$font>$form_names</font></td>
        <td valign="top"><$font>$form_values</font></td>
      </tr>
~;
    }
    $output .= qq~</table>~;

    return { user => $output };
}

sub _validate_step5 {
# -------------------------------------------------------------------
# Validate any user options that were added.
#
    my $self = shift;
    $self->{plugin}->{user} ||= [];

# Remove unwanted user options.
    my $results = '';
    if ($self->{cgi}->param('delete_btn')) {
        my @to_delete = $self->{cgi}->param('delete');
        for my $del_id (@to_delete) {
            my $i = 0;
            for my $opt (@{$self->{plugin}->{user}}) {
                my ($name, $val, $ins) = @$opt;
                if ($name eq $del_id) {
                    splice @{$self->{plugin}->{user}}, $i, 1;
                    $results .= "<li>User Option " . $name . " successfully removed.";
                }
                $i++;
            }
        }
    }

# Add new user option
    my $add_name = $self->{cgi}->param('name');
    if ($add_name) {
        my $add_val     = $self->{cgi}->param('value');
        my $add_ins     = $self->{cgi}->param('instructions');
        my $form_names  = [ grep $_, split /(?:\r|\n)+/, $self->{cgi}->param('form_names') ];
        my $form_values = [ grep $_, split /(?:\r|\n)+/, $self->{cgi}->param('form_values') ];
        my $form_type   = $self->{cgi}->param('form_type');
        push @{$self->{plugin}->{user}}, [ $add_name, $add_val, $add_ins, $form_type, $form_names, $form_values ];
        $results .= "<li>User Option $add_name successfully added.";
    }
    my $user = $self->_load_step5;
    if (! $results and $self->{cgi}->param('add_btn')) {
        return { error => "Please fill out the add form completely.", user => $user->{user} };
    }
    if (! $results and $self->{cgi}->param('delete_btn')) {
        return { error => "Please select one or more user option to delete.", user => $user->{user} };
    }
    $self->save_plugin or return { error => $GT::Plugins::error };
    if ($results) {
        return { results => $results, user => $user->{user} };
    }
    return {};
}

sub _load_step6 {
# -------------------------------------------------------------------
# Preloads any user included files.
#
    my $self = shift;
    return { files => '' } unless (defined $self->{plugin}->{files} and @{$self->{plugin}->{files}});

    my $font   = 'font face="Tahoma,Arial,Helvetica" size="2"';
    my $output = qq~
<table border=1 width="100%" cellpadding=3 bordercolor="#C0C0C0" cellspacing=0><tr>
    <td><b><$font>Filename</font></b></td>
    <td><b><$font>Location</font></b></td>
    </tr>~;

    my %seen;
    for my $file (@{$self->{plugin}->{files}}) {
        my ($name, $location) = @$file;
        my $id = join("|", @$file);
        next if $name eq "$self->{plugin}->{name}.pm";
        if (exists $self->{dirs}->{$location}) {
            $location = $self->{dirs}->{$location};
        }
        $seen{$name}++;
        $output .= qq~
<tr>
    <td><$font><input type="checkbox" name="delete" value="$id"> $name</font></td>
    <td><$font>$location</font></td>
    </tr>~;
    }
    my $files = $self->{tar}->files;
    for my $file (@$files) {
        my $name = $file->name;
        my $id = $name . '|';

        next if $seen{$name} or $name eq 'Wizard.pm' or $name eq 'Install.pm' or $name eq "$self->{plugin}->{name}.pm";

        push @{$self->{plugin}->{files}}, [$name, ''];
        $output .= qq~
<tr>
    <td><$font><input type="checkbox" name="delete" value="$id"> $name</font></td>
    <td><$font>Unknown (not added in Wizard)</font></td>
    </tr>~;
    }
    $output .= qq~
</table>
    ~;
    return { files => $output };
}

sub _validate_step6 {
# -------------------------------------------------------------------
# Receives files and stores them in the tar file.
#
    my $self = shift;
    my $results = '';
    $self->{plugin}->{files} ||= [];

# Remove any existing files.
    if ($self->{cgi}->param('delete_btn')) {
        my @to_delete = $self->{cgi}->param('delete');
        for my $del_id (@to_delete) {
            my $i = 0;
            for my $file (@{$self->{plugin}->{files}}) {
                my $id = join("|", @$file);
                if ($id eq $del_id) {
                    my $name = $file->[0];
                    $self->{tar}->remove_file($name);
                    $self->{tar}->write;
                    splice @{$self->{plugin}->{files}}, $i, 1;
                    $results .= "<li>File " . $name . " successfully removed.";
                }
                $i++;
            }
        }
    }

# Add any new attachments.
    my $filename = $self->{cgi}->param('name');
    if ($filename) {
        my $filehandle = $self->{cgi}->param('file');
        my $body       = $self->{cgi}->param('add_body');
        my $location   = $self->{cgi}->param('location');
        if (ref $filehandle) {
            $body = '';
            my ($buffer, $read);
            while ($read = read($filehandle, $buffer, 4096)) {
                $body .= $buffer;
            }
        }
        $body ||= ' ';
        $body =~ s/\r//g;
        push @{$self->{plugin}->{files}}, [$filename, $location];
        my $res = $self->{tar}->add_data(name => $filename, body => $body);
        $results .= "File $filename attached successfully.";
    }
    my $file = $self->_load_step6;
    $self->save_plugin or return { error => $GT::Plugins::error };

    if (! $results and $self->{cgi}->param('add_btn')) {
        return { error => "Please fill out the add form completely.", files => $file->{files} };
    }
    if (! $results and $self->{cgi}->param('delete_btn')) {
        return { error => "Please select one or more file to delete.", files => $file->{files} };
    }
    if ($results) {
        return { results => $results, files => $file->{files} };
    }
    return {};
}

sub _load_step7 {
# -------------------------------------------------------------------
# Fetches the install/uninstall message.
#
    my $self = shift;
    return {
        install        => $self->{plugin}->{install},
        uninstall      => $self->{plugin}->{uninstall},
        install_code   => $self->{plugin}->{install_code},
        uninstall_code => $self->{plugin}->{uninstall_code}
    };
}

sub _validate_step7 {
# -------------------------------------------------------------------
# Saves the install/uninstall message.
#
    my $self = shift;
    $self->{plugin}->{install}        = $self->{cgi}->param('install');
    $self->{plugin}->{uninstall}      = $self->{cgi}->param('uninstall');
    $self->{plugin}->{install_code}   = $self->{cgi}->param('install_code');
    $self->{plugin}->{uninstall_code} = $self->{cgi}->param('uninstall_code');
    $self->save_plugin or return { error => $GT::Plugins::error };
    return {};
}

sub _create_code {
# -------------------------------------------------------------------
# Creates the code file.
#
    my $self = shift;
    my $output = '';
    my $time = localtime();
    my $version = $self->{plugin}->{meta}->{version} || 0;
    $self->{install_header} ||= '';
    my $stubs = $self->_create_stubs;

    my $plugin_pkg = $self->{prefix} . $self->{plugin}->{name};
    if (index($plugin_pkg, 'Plugins::') < 0) {
        $plugin_pkg = 'Plugins::' . $plugin_pkg;
    }

    $output = <<END_OF_PLUGIN;
# ==================================================================
# $plugin_pkg - Auto Generated Program Module
#
#   $plugin_pkg
#   Author  : $self->{plugin}->{meta}->{author}
#   Version : $version
#   Updated : $time
#
# ==================================================================
#

package $plugin_pkg;
# ==================================================================

$self->{initial_indent}use strict;
$self->{initial_indent}use GT::Base;
$self->{initial_indent}use GT::Plugins qw/STOP CONTINUE/;
$self->{initial_indent}$self->{install_header}

# Inherit from base class for debug and error methods
$self->{initial_indent}\@${plugin_pkg}::ISA = qw(GT::Base);

# Your code begins here.
$stubs

# Always end with a 1.
1;
END_OF_PLUGIN
    my $file = $self->{tar}->get_file($self->{plugin}->{name} . '.pm');
    if ($file) {
        my $overwrite = $self->{cgi}->param('overwrite');
        my $skip = $self->{cgi}->param('skip');
        if (! $overwrite and ! $skip) {
            return { error => "Overwrite the existing $self->{plugin}->{name}.pm: <br><input type=submit name=overwrite value='Yes, Overwrite it!'> <input type=submit name=skip value='No, Leave it Alone'>" };
        }
        $file->body($output) if ($overwrite);
    }
    else {
        $self->{tar}->add_data( name => $self->{plugin}->{name} . '.pm', body => $output );
    }
    $self->{tar}->write;
    return {};
}

sub _create_install {
# -------------------------------------------------------------------
# Creates the install.pm file.
#
    my $self   = shift;
    my $output = '';
    my $time   = localtime();
    my $version = $self->{plugin}->{meta}->{version} || 0;
    (my $qversion = $version) =~ s/(?=['\\])/\\/g;

    my $meta_dump = GT::Dumper->dump(var => '$META', data => $self->{plugin}->{meta});
    my $inst_mess = GT::Dumper->dump(var => 'my $inst_msg', data => $self->{plugin}->{install});
    my $uninst_mess = GT::Dumper->dump(var => 'my $uninst_msg', data => $self->{plugin}->{uninstall});
    my $install  = $self->_create_install_func;
    my $uninstall   = $self->_create_uninstall_func;

    for ($meta_dump, $inst_mess, $uninst_mess, $install, $uninstall) { s/\r//g }

    my $inst_code = $self->{plugin}->{install_code} || '';
    $inst_code =~ s/\r//g;
    $inst_code =~ s/;?$/;/; # Not ending a statement with a ; is valid Perl; handle it here.
    my $uninst_code = $self->{plugin}->{uninstall_code} || '';
    $uninst_code =~ s/\r//g;
    $uninst_code =~ s/;?$/;/; # Not ending a statement with a ; is valid Perl; handle it here.
    $self->{install_header} ||= '';

    my $plugin_pkg = $self->{prefix} . $self->{plugin}->{name};
    if (index($plugin_pkg, 'Plugins::') < 0) {
        $plugin_pkg = 'Plugins::' . $plugin_pkg;
    }

    $output    = <<END_OF_PLUGIN;
# ==================================================================
# $plugin_pkg - Auto Generated Install Module
#
#   $plugin_pkg
#   Author  : $self->{plugin}->{meta}->{author}
#   Version : $version
#   Updated : $time
#
# ==================================================================
#

package $plugin_pkg;
# ==================================================================
$self->{initial_indent}use strict;
$self->{initial_indent}use vars  qw/\$VERSION \$DEBUG \$NAME \$META/;
$self->{initial_indent}use GT::Base;
$self->{initial_indent}use GT::Plugins qw/STOP CONTINUE/;
$self->{initial_indent}$self->{install_header}

$self->{initial_indent}\$VERSION = '$qversion';
$self->{initial_indent}\$DEBUG   = 0;
$self->{initial_indent}\$NAME    = '$self->{plugin}->{name}';
# Inhert from base class for debug and error methods
$self->{initial_indent}\@${plugin_pkg}::ISA = qw(GT::Base);

$self->{initial_indent}$meta_dump

sub pre_install {
# -----------------------------------------------------------------------------
# This function displays an HTML formatted message that will display any
# instructions/information to the user before they install the plugin.
#
    $inst_mess
    return \$inst_msg;
}

sub pre_uninstall {
# -----------------------------------------------------------------------------
# This function displays an HTML formatted message that will display any
# instructions/information to the user before they remove the plugin.
#
    $uninst_mess
    return \$uninst_msg;
}

sub install {
# -----------------------------------------------------------------------------
# This function does the actual installation.  Its first argument is a plugin
# manager which you can use to register hooks, install files, add menu options,
# etc.  The second argument is a GT::Tar object which you can use to access any
# files in your plugin module.
#
# You should return an HTML formatted string that will be displayed to the
# user.
#
# If there is an error, return undef, and set the error message in
# \$Plugins::$self->{prefix}$self->{plugin}->{name}::error
#
    my (\$mgr, \$tar) = \@_;
    $install
    $inst_code
    return "The plugin has been successfully installed!";
}

sub uninstall {
# -----------------------------------------------------------------------------
# This function removes the plugin.  Its first argument is also a plugin
# manager which you can use to register hooks, install files, add menu options,
# etc. You should return an HTML formatted string that will be displayed to the
# user.
#
# If there is an error, return undef, and set the error message in
# \$${plugin_pkg}::error
#
    my \$mgr = shift;
    $uninstall
    $uninst_code
    return "The plugin has been successfully removed!";
}

1;
END_OF_PLUGIN
    my $file = $self->{tar}->get_file('Install.pm');
    if ($file) {
        $file->body($output);
    }
    else {
        $self->{tar}->add_data(name => 'Install.pm', body => $output);
    }
    $self->{tar}->write;
    return {};
}

sub _esc {
# -------------------------------------------------------------------
    $_[0] =~ s/'/\\'/g;
    $_[0] =~ s/\n/\\\n/g;
    $_[0] =~ s/\r//g;
    return;
}

sub _create_install_func {
# -------------------------------------------------------------------
# Creates the install function based on everything we know.
#
    my $self = shift;
    my $code = '';
    for my $hook (@{$self->{plugin}->{hooks}}) {
        my $val1 = $hook->[0]; $val1 =~ s/'/\\'/g;
        my $val2 = $hook->[1]; $val2 =~ s/'/\\'/g;
        my $val3 = $hook->[2]; $val3 =~ s/'/\\'/g;
        my $val4 = $hook->[3];

        $code .= qq~\n    \$mgr->install_hooks('$self->{plugin}->{name}', [['$val1', '$val2', '$val3', '$val4']]);~;
    }
    for my $menu (@{$self->{plugin}->{menu}}) {
        my $val1 = $menu->[0]; $val1 =~ s/'/\\'/g;
        my $val2 = $menu->[1]; $val2 =~ s/'/\\'/g;
        $code .= qq~\n    \$mgr->install_menu('$self->{plugin}->{name}', [['$val1', '$val2']]);~;
    }
    for my $user (@{$self->{plugin}->{user}}) {
        my $val1 = $user->[0]; $val1 =~ s/'/\\'/g;
        my $val2 = $user->[1]; _esc($val2);
        my $val3 = $user->[2]; _esc($val3);
        my $val4 = $user->[3]; _esc($val4);
        require GT::Dumper;
        my $val5 = GT::Dumper->dump(var => '', data => $user->[4], compress => 1 ); $val5 =~ s/;$//;
        my $val6 = GT::Dumper->dump(var => '', data => $user->[5], compress => 1 ); $val6 =~ s/;$//;
        my $val7 = $user->[6]; _esc($val7);
        $code .= qq~\n    \$mgr->install_options('$self->{plugin}->{name}', [['$val1', '$val2', '$val3', '$val4', $val5, $val6, '$val7']]);~;
    }
    if (@{$self->{plugin}->{files}}) {
        $code .= qq~

# Silence warnings
    \$GT::Tar::error ||= '';

# The following section will unarchive attached files into the proper location.
    my \$file;~;
    }
    for my $file (@{$self->{plugin}->{files}}) {
        my ($name, $loc) = @$file;
        next if ($name eq $self->{plugin}->{name} . '.pm');
        next if ($name eq 'Install.pm');
        my $path = '';
        if (exists $self->{dirs}->{$loc}) {
            $path = $self->{dirs}->{$loc};
        }

        my $plugin_pkg = $self->{prefix} . $self->{plugin}->{name};
        if (index($plugin_pkg, 'Plugins::') < 0) {
            $plugin_pkg = 'Plugins::' . $plugin_pkg;
        }
        $code .= qq~

# Copying $name to $path directory.
    \$file = \$tar->get_file('$name');
    \$file->name("$path/$name");
    \$file->write or return $plugin_pkg->error("Unable to extract file '$path/$name': \$GT::Tar::error", 'WARN');~;
    }
    return $code;
}

sub _create_uninstall_func {
# -------------------------------------------------------------------
# Creates the uninstall function based on everything we know.
#
    my $self = shift;
    my $code = '';
    for my $hook (@{$self->{plugin}->{hooks}}) {
        my $val1 = $hook->[0]; $val1 =~ s/'/\\'/g;
        my $val2 = $hook->[1]; $val2 =~ s/'/\\'/g;
        my $val3 = $hook->[2]; $val3 =~ s/'/\\'/g;
        my $val4 = $hook->[3];
        $code .= qq~\n    \$mgr->uninstall_hooks('$self->{plugin}->{name}', [['$val1', '$val2', '$val3', '$val4']]);~;
    }
    for my $menu (@{$self->{plugin}->{menu}}) {
        my $val1 = $menu->[0]; $val1 =~ s/'/\\'/g;
        my $val2 = $menu->[1]; $val2 =~ s/'/\\'/g;
        $code .= qq~    \$mgr->uninstall_menu('$self->{plugin}->{name}', [['$val1', '$val2']]);~;
    }
    for my $user (@{$self->{plugin}->{user}}) {
        my $val1 = $user->[0]; $val1 =~ s/'/\\'/g;
        my $val2 = $user->[1]; _esc($val2);
        my $val3 = $user->[2]; _esc($val3);
        my $val4 = $user->[3]; _esc($val4);
        require GT::Dumper;
        my $val5 = GT::Dumper->dump(var => '', data => $user->[4], compress => 1 ); $val5 =~ s/;$//;
        my $val6 = GT::Dumper->dump(var => '', data => $user->[5], compress => 1 ); $val6 =~ s/;$//;
        my $val7 = $user->[6]; _esc($val7);

        $code .= qq~\n    \$mgr->uninstall_options('$self->{plugin}->{name}', [['$val1', '$val2', '$val3', '$val4', $val5, $val6, '$val7']]);~;
    }
    return $code;
}

sub _create_stubs {
# -------------------------------------------------------------------
# Creates a subroutine stub for each hook.
#
    my $self = shift;
    my $code = '';
    if (@{$self->{plugin}->{hooks}}) {
        $code .= qq~

# PLUGIN HOOKS
# ===================================================================
~;
    }
    my %seen;
    for my $hook (@{$self->{plugin}->{hooks}}) {
        my $full_sub_name = $hook->[2];
        my ($sub_name) = $full_sub_name =~ /([^:]+)$/;
        next if $seen{$sub_name}++;
        my $hook_name = $hook->[0];
        $code .= qq~

sub $sub_name {
# -----------------------------------------------------------------------------
# This subroutine will be called whenever the hook '$hook_name' is run.  You
# should call @{[$self->{oo} || 'GT::Plugins']}->action(STOP) if you don't want the regular
# '$hook_name' code to run, otherwise the code will continue as normal.
#
    my (\@args) = \@_;

# Do something useful here

    return \@args;
}~;
    }
    if (@{$self->{plugin}->{menu}}) {
        $code .= qq~

# ADMIN MENU OPTIONS
# ===================================================================
~;
    }
    %seen = ();
    for my $menu (@{$self->{plugin}->{menu}}) {
        my $val1 = $menu->[0];
        my $val2 = $menu->[1];
        my ($func) = $val2 =~ /func=(\w+)/;
        next if $seen{$func}++;
        if ($func) {
            $code .= qq~
sub $func {
# -------------------------------------------------------------------
# This subroutine will be called whenever the user clicks on '$val1' in the
# admin menu.  Remember, you need to print your own HTTP header; to do so you
# can use:
#
#   print \$IN->header();
#

}~;
        }
    }
    return $code;
}

sub _create_wizard {
# -------------------------------------------------------------------
# Creates the Wizard.pm file which is used to load wizard information.
#
    my $self   = shift;
    my $output = '';
    my $time   = localtime();
    my $author = $self->{plugin}->{meta}->{author} || '';
    my $version = $self->{plugin}->{meta}->{version} || '';
    my $meta_dump = GT::Dumper->dump(var => '$META', data => $self->{meta});

    my $plugin_pkg = $self->{prefix} . $self->{plugin}->{name};
    if (index($plugin_pkg, 'Plugins::') < 0) {
        $plugin_pkg = 'Plugins::' . $plugin_pkg;
    }

    $output    = <<END_OF_PLUGIN;
# ==================================================================
# Auto Generated Plugin Configuration - Needed for Web Based Creator.
#
#   $plugin_pkg
#   Author  : $author
#   Version : $version
#   Updated : $time
#
# ==================================================================
#

package $plugin_pkg;
# ==================================================================
$self->{initial_indent}use strict;
$self->{initial_indent}use vars qw/\$WIZARD/;

END_OF_PLUGIN
    $output .= GT::Dumper->dump(var => '$WIZARD', data => $self->{plugin});
    $output .= "\n\n1;\n";
    return $output;
}

sub _load_tar {
# -------------------------------------------------------------------
# Loads a tar file.
#
    my $self = shift;
    my $file = $self->{plugin_dir} . "/Uninstalled/" . $self->{plugin}->{name} . ".tar";
    if (-e $file) {
        $self->{tar} = GT::Tar->open($file) or return $self->error('CANTLOAD', 'FATAL', $file, $GT::Tar::error);
    }
    else {
        $self->{tar} = new GT::Tar($file) or return $self->error('CANTLOAD', 'FATAL', $file, $GT::Tar::error);
    }
}

sub _load_plugin {
# -------------------------------------------------------------------
# Loads the meta information into self.
#
    my $self   = shift;
    my $wizard = $self->{tar}->get_file('Wizard.pm')
        or return $self->error('CANTLOAD', 'WARN', $self->{plugin}->{name}, "No Wizard.pm file found in tar!");

# Eval the install file.
    my $file = $wizard->body_as_string;
    {
        local ($@, $SIG{__DIE__}, $^W);
        eval "$file";
        if ($@) {
            return $self->error('CANTLOAD', 'WARN', $file, "Wizard.pm does not compile: $@");
        }
    }

# Load the information.

    my $plugin_pkg = $self->{prefix} . $self->{plugin}->{name};
    if (index($plugin_pkg, 'Plugins::') < 0) {
        $plugin_pkg = 'Plugins::' . $plugin_pkg;
    }

    my $var = $plugin_pkg . "::WIZARD";
    {
        no strict 'refs';
        $self->{plugin} = $$var;
    }

    return 1;
}

sub _list_editable {
# -------------------------------------------------------------------
# Returns a select list of plugins that can be edited by the wizard.
#
    my $self = shift;
    my $dir  = $self->{plugin_dir} . '/Uninstalled';
    my %plugins;
    my $count  = 0;
    my $select = "<select name=plugin_name>";
    opendir (DIR, $dir) or return $self->error('CANTOPEN', 'FATAL', $dir, "$!");
    while (defined(my $file = readdir(DIR))) {
        next unless ($file =~ /^(.+)\.tar$/);
        my $plugin_name = $1;
        $select .= "<option>$plugin_name";
        $count++;
    }
    closedir(DIR);
    $select .= "</select>";
    return $count ? $select : '';
}

1;