File Coverage

blib/lib/WWW/phpBB/Mod/Installer.pm

Criterion	Covered	Total	%
statement	25	27	92.5
branch			n/a
condition			n/a
subroutine	9	9	100.0
pod			n/a
total	34	36	94.4

package WWW::phpBB::Mod::Installer;

use 5.008008;
use strict;
use warnings;

use Carp;
use File::Basename;
use Data::Dumper;
use Cwd 'abs_path';
use File::Copy;
use XML::Xerces;
use DBI;


our $VERSION = '0.03';


require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw() ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(uninstall_phpbb_mod
                 install_phpbb_mod
);


use constant ERROR => 'ERROR';
use constant DEBUG => 'DEBUG';
use constant AUDIT => 'AUDIT';

use constant INSTALL   => 'INSTALL';
use constant UNINSTALL => 'UNINSTALL';

use constant DEFAULT_LANG    => 'en';
use constant DEFAULT_STYLE   => 'prosilver';
use constant DEFAULT_VERSION => 0;


my $script_absolute_path;
my $install_absolute_path;
my $install_absolute_file;
my $web_root_absolute_path;
my $backup_dir;
my $config_file;
my %log_handles;
my %headers;
my $phpbb_config_ref;
my $dbh;
my $phpbb_version;
my $style;
my $lang;


###############################
# TODO
# 1. Support the uninstall command
# which will remove any edits made
# and also delete files copied as part of the install
# It will not modify the database.
#
##############################

sub uninstall_phpbb_mod{
    my %args = shift;
    $args{OPERATION} = UNINSTALL;
    install_mod(%args);
}

sub install_phpbb_mod{
    my %args = (@_);
    my $install_file = $args{INSTALL_FILE};
    my $web_root     = $args{WEB_ROOT};
    my $tmp_style    = $args{STYLE};
    my $tmp_lang     = $args{LANG};
    my $operation    = $args{OPERATION} || INSTALL;

    _setup();

    unless (-f $install_file) {
        _write_log_entry(ERROR, "The install file '$install_file' does not exist.");
        croak "\n\nThe install file '$install_file' does not exist.\n\n";
    }
    unless (-d $web_root) {
        _write_log_entry(ERROR, "The phpbb web root directory '$web_root' does not exist.");
        croak "\n\nThe phpbb web root directory '$web_root' does not exist.\n\n";
    }

    $install_absolute_path  = abs_path( dirname($install_file) );
    if ($install_absolute_path =~ /^(.*)\/templates$/){
        $install_absolute_path = $1;
    }
    _write_log_entry(DEBUG, "Install root path: $install_absolute_path");
    $install_absolute_file  = abs_path($install_file);
    _write_log_entry(DEBUG, "Install file: $install_absolute_file");
    $web_root_absolute_path = abs_path( $web_root);
    _write_log_entry(DEBUG, "phpBB web root: $web_root_absolute_path");
    $config_file            = "$web_root_absolute_path/config.php";
    _write_log_entry(DEBUG, "phpBB config file: $config_file");

    unless (-f $config_file) {
        _write_log_entry(ERROR, "The phpbb web root directory '$web_root_absolute_path' does not contain a config.php");
        croak "\n\nThe phpbb web root directory '$web_root_absolute_path' does not contain a config.php\n\n";
    }

    $phpbb_config_ref = _read_phpbb_config();
    eval {my $dbh = _mysql_connect();};
    $phpbb_version = _get_phpbb_version();
    $lang = $tmp_lang || _get_phpbb_lang();
    _write_log_entry(AUDIT, "Language: '$lang'");
    $style = $tmp_style || _get_phpbb_style();
    _write_log_entry(AUDIT, "Style: '$style'");

    _write_log_entry(AUDIT, "Initialisation complete, processing installation file '$install_absolute_file'");
    my $doc = _load_install_file($install_absolute_file);
    my $instruction_ref = _process_document($doc);
    _write_log_entry(DEBUG, 'Instruction list: ' . Data::Dumper->Dump([$instruction_ref]));

    if ($headers{target_version} ne $phpbb_version){
        warn "\nWARNING: This mod is intended for a different version of phpbb\n" .
             "\tBoard Version $phpbb_version\n" .
             "\tMod written for version $headers{target_version}\n\n";
    }

    if ($operation eq INSTALL){
        _write_log_entry(AUDIT, "Beginning installation for mod $headers{title} " .
                                "version $headers{version_major}.$headers{version_minor}".
                                ".$headers{version_revision}$headers{version_release} " .
                                "by $headers{author}");
        _process_instructions($instruction_ref, $backup_dir);
    }
    elsif($operation eq UNINSTALL){
        _write_log_entry(AUDIT, "Beginning uninstall for mod $headers{title} " .
                                "version $headers{version_major}.$headers{version_minor}".
                                ".$headers{version_revision}$headers{version_release} " .
                                "by $headers{author}");
        _process_uninstall($instruction_ref, $backup_dir);
    }
    else{
        _write_log_entry(ERROR, "Unsupported operation '$operation'.\n");
        croak "Unsupported operation '$operation'.\n" .
              "Only\n\tOPERATION => 'INSTALL'\n\tOPERATION => 'UNINSTALL'\n" .
              "are supported.\n";
    }

    _write_log_entry(AUDIT, 'Complete');
    _tear_down();
}


sub _setup{
    $script_absolute_path   = abs_path( dirname($0) );

    $backup_dir = _create_backup_dirs($script_absolute_path);

    my $log_dir = "$script_absolute_path/logs";
    if (!-d $log_dir){
        _create_dir_recursive($log_dir);
    }

    open(my $error_handle, '>>', "$log_dir/error.log")
        or croak "Can't open error log file $log_dir/error.log: $!\n";
    open(my $debug_handle, '>>', "$log_dir/debug.log")
        or croak "Can't open debug log file $log_dir/debug.log: $!\n";
    open(my $audit_handle, '>>', "$log_dir/audit.log")
        or croak "Can't open audit log file $log_dir/audit.log: $!\n";

    $log_handles{ERROR} = $error_handle;
    $log_handles{DEBUG} = $debug_handle;
    $log_handles{AUDIT} = $audit_handle;
}

sub _tear_down{
    $dbh->disconnect() if $dbh;
    foreach my $handle (keys %log_handles){
        close $log_handles{$handle};
    }
}

sub _get_phpbb_version{
    my $version;
    if ($dbh){
        my $sql = "select * from " . $phpbb_config_ref->{table_prefix} .
                    "config where config_name = 'version'" ;
        my $res ;
        #selectall_hashref causes warnings from File::Copy under windows
        #eval{$res = $dbh->selectall_hashref($sql, 'config_name') } ;
        eval{$res = $dbh->selectall_arrayref($sql) } ;
        $version = $res->[0]->[1];
        _write_log_entry(AUDIT, "phpBB version: $version");
    }
    else{
        _write_log_entry(AUDIT, 'No database connection, cannot get phpBB version');
    }

    if (!$version){
        $version = DEFAULT_VERSION;
    }

    return $version;
}

sub _get_phpbb_lang{
    my $lang;
    if ($dbh){
        my $sql = "select config_value from " . $phpbb_config_ref->{table_prefix} .
                    "config where config_name = 'default_lang'" ;
        my $res ;
        #selectall_hashref causes warnings from File::Copy under windows
        #eval{$res = $dbh->selectall_hashref($sql, 'config_name') } ;
        eval{$res = $dbh->selectall_arrayref($sql) } ;
        $lang = $res->[0]->[0];
        _write_log_entry(DEBUG, "phpBB default lang: $lang");
    }
    else{
        _write_log_entry(AUDIT, 'No database connection, cannot get phpBB language');
    }

    if (!$lang){
        $lang = DEFAULT_LANG;
    }

    return $lang;
}

sub _get_phpbb_style{
    my $style;
    if ($dbh){
        my $sql = "select template_path from " . $phpbb_config_ref->{table_prefix} .
                  "styles_template where template_id = " .
                    "(select template_id from " . $phpbb_config_ref->{table_prefix} .
                    "styles where style_id = " .
                        "(select config_value from " . $phpbb_config_ref->{table_prefix} .
                        "config where config_name = 'default_style'))" ;
        my $res ;
        #selectall_hashref causes warnings from File::Copy under windows
        #eval{$res = $dbh->selectall_hashref($sql, 'config_name') } ;
        eval{$res = $dbh->selectall_arrayref($sql) } ;
        $style = $res->[0]->[0];
        _write_log_entry(DEBUG, "phpBB default style path: $style");
    }
    else{
        _write_log_entry(AUDIT, 'No database connection, cannot get phpBB style');
    }

    if (!$style){
        $style = DEFAULT_STYLE;
    }

    return $style;
}

sub _mysql_connect {

    if ($phpbb_config_ref->{dbms} eq 'mysql'){
        $dbh = DBI->connect(
            'DBI:mysql:database=' . $phpbb_config_ref->{dbname} .';host=' . $phpbb_config_ref->{dbhost},
            $phpbb_config_ref->{dbuser},
            $phpbb_config_ref->{dbpasswd},
            {   RaiseError => 1,
                AutoCommit => 1,
            }
        );
    }
    else{
        _write_log_entry(AUDIT, 'Only mysql databases are supported, database updates are not possible');
    }

    return $dbh;
}

sub _read_phpbb_config{
    my %phpbb_config;
    open IN, '<', $config_file or croak "Can't open phpbb config file: $!\n";
    while() {
        my $line=$_;
        if ($line =~ /^\s*\$(\w+)\s*=\s*'(\w*)'\;\s*$/) {
            $phpbb_config{$1} = $2;
        }
        elsif ($line =~ /^\s*\@define\('(\w+)',\s*(\w+)\);\s*$/){
            $phpbb_config{$1} = $2;
        }
    }
    close (IN);
    _write_log_entry(DEBUG, "phpBB Config: " . Data::Dumper->Dump([\%phpbb_config]));

    return \%phpbb_config;
}

sub _load_install_file {
    my $install_filename = shift;

    #create a parser and attempt to parse the XML document
    my $dom = XML::Xerces::XercesDOMParser->new();
    my $error_handler = XML::Xerces::PerlErrorHandler->new();
    $dom->setErrorHandler($error_handler);
    eval{$dom->parse($install_filename)};
    croak("Couldn't parse file: $install_filename\n$@") if $@;

    #the parse was successful, we have a well formed xml instance
    my $doc = $dom->getDocument();

    return $doc;
}

sub _write_log_entry{
    my $type = shift;
    my $message = shift;

    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
        = localtime(time);
    my $curr_time = sprintf "%4d-%02d-%02d %02d:%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min,$sec;
    my $log_line = "$curr_time - $message\n";

    my $file_handle = $log_handles{$type};
    if ($file_handle){
        print $file_handle $log_line;
    }
    else{
        warn $log_line;
    }
}

sub _process_document {
    my $install_doc = shift;

    my @instruction_list;
    my $root = $install_doc->getDocumentElement();

    if ($root->hasChildNodes()) {
        ROOT: foreach my $child ($root->getChildNodes) {
            my $child_name = $child->getNodeName();
            if ($child->isa('XML::Xerces::DOMElement')){
                if ($child_name eq 'action-group'){
                    #process this node
                    if ($child->hasChildNodes()) {
                        foreach my $action ($child->getChildNodes) {
                            my $action_name = $action->getNodeName();
                            if ($action->isa('XML::Xerces::DOMElement')){
                                if ($action_name eq 'copy'){
                                    my $copy_ref = _process_copy($action);
                                    push (@instruction_list, $copy_ref);
                                }
                                elsif ($action_name eq 'sql'){
                                    my $sql_ref = _process_sql($action);
                                    push (@instruction_list, $sql_ref);
                                }
                                elsif ($action_name eq 'open'){
                                    my $open_ref = _process_open($action);
                                    push (@instruction_list, $open_ref);
                                }
                                elsif ($action_name eq 'diy-instructions'){
                                    my $diy_ref = _process_diy_instructions($action);
                                    push (@instruction_list, $diy_ref);
                                }
                            }
                        }
                    }
                    else{
                        #no actions
                        croak "No actions to perform\n";
                    }
                }
                elsif ($child_name eq 'header'){
                    _process_header($child);
                }
                else{
                    _write_log_entry(DEBUG, "Found additional first level child '$child_name' - skipping....");
                }
            }
        }
    }
    else{
        croak "Empty document nothing to process\n";
    }

    return \@instruction_list;
}

sub _process_header{
    my $header = shift;

    foreach my $child ($header->getChildNodes) {
        my $child_name = $child->getNodeName();
        if ($child->isa('XML::Xerces::DOMElement')){
            if ($child_name eq 'title'){
                $headers{title} = $headers{title} || $child->getTextContent();
                my %child_attrs = $child->getAttributes();
                foreach my $attr_name (keys %child_attrs) {
                    if ($attr_name eq 'lang'){
                        if ($child_attrs{$attr_name} eq $lang){
                            $headers{title} = $child->getTextContent();
                        }
                    }
                }
            }
            elsif ($child_name eq 'description'){
                $headers{description} = $headers{description} || $child->getTextContent();
                my %child_attrs = $child->getAttributes();
                foreach my $attr_name (keys %child_attrs) {
                    if ($attr_name eq 'lang'){
                        if ($child_attrs{$attr_name} eq $lang){
                            $headers{description} = $child->getTextContent();
                        }
                    }
                }
            }
            elsif ($child_name eq 'author-group'){
                foreach my $ag_child($child->getChildNodes) {
                    my $ag_name = $ag_child->getNodeName();
                    if ($ag_child->isa('XML::Xerces::DOMElement')){
                        if ($ag_name eq 'author'){
                            foreach my $author_child($ag_child->getChildNodes) {
                                my $author_name = $author_child->getNodeName();
                                if ($author_child->isa('XML::Xerces::DOMElement')){
                                    if ($author_name eq 'realname'){
                                        $headers{author} = $author_child->getTextContent();
                                    }
                                    elsif ($author_name eq 'username'){
                                        $headers{author_username} = $author_child->getTextContent();
                                    }
                                }
                            }
                        }
                    }
                }
            }
            elsif ($child_name eq 'mod-version'){
                foreach my $mv_child($child->getChildNodes) {
                    my $mv_name = $mv_child->getNodeName();
                    if ($mv_child->isa('XML::Xerces::DOMElement')){
                        if ($mv_name eq 'major'){
                            $headers{version_major} = $mv_child->getTextContent();
                        }
                        elsif ($mv_name eq 'minor'){
                            $headers{version_minor} = $mv_child->getTextContent();
                        }
                        elsif ($mv_name eq 'revision'){
                            $headers{version_revision} = $mv_child->getTextContent();
                        }
                        elsif ($mv_name eq 'release'){
                            $headers{version_release} = $mv_child->getTextContent();
                        }
                    }
                }
            }
            elsif ($child_name eq 'installation'){
                foreach my $i_child($child->getChildNodes) {
                    my $i_name = $i_child->getNodeName();
                    if ($i_child->isa('XML::Xerces::DOMElement')){
                        if ($i_name eq 'target-version'){
                            foreach my $tv_child($i_child->getChildNodes) {
                                my $tv_name = $tv_child->getNodeName();
                                if ($tv_child->isa('XML::Xerces::DOMElement')){
                                    if ($tv_name eq 'target-primary'){
                                        $headers{target_version} = $tv_child->getTextContent();
                                    }
                                }
                            }
                        }
                    }
                }
            }
        }
    }
    foreach my $nv_name(qw{author author_username version_major
                            version_minor version_revision
                            version_release title description}){
        if (!defined $headers{$nv_name}){
            $headers{$nv_name} = '';
        }
    }
    _write_log_entry(DEBUG, "Install file header values: " . Data::Dumper->Dump([\%headers]));
}

sub _process_copy{
    my $copy_node = shift;

    my %return_hash;
    my @file_array;
    $return_hash{action} = 'copy';

    foreach my $child ($copy_node->getChildNodes) {
        my $child_name = $child->getNodeName();
        if ($child->isa('XML::Xerces::DOMElement')){
            if ($child_name eq 'file'){
                my %file_hash;
                my %file_attrs = $child->getAttributes();
                foreach my $attr_name (keys %file_attrs) {
                    $file_hash{$attr_name} = $file_attrs{$attr_name};
                }
                push (@file_array, \%file_hash);
            }
        }
    }

    $return_hash{files} = \@file_array;
    return \%return_hash;
}

sub _process_open{
    my $open_node = shift;
    my %return_hash;
    my @edits;
    $return_hash{action} = 'open';

    my %open_attrs = $open_node->getAttributes();
    foreach my $attr_name (keys %open_attrs) {
        if ($attr_name eq 'src'){
            $return_hash{src} = $open_attrs{$attr_name};
        }
    }
    foreach my $child ($open_node->getChildNodes) {
        my $child_name = $child->getNodeName();
        if ($child->isa('XML::Xerces::DOMElement')){
            if ($child_name eq 'edit'){
                my %edit_hash;
                foreach my $edit_child ($child->getChildNodes) {
                    my $edit_child_name = $edit_child->getNodeName();
                    if ($edit_child->isa('XML::Xerces::DOMElement')){
                        if ($edit_child_name eq 'find'){
                            $edit_hash{find} = $edit_child->getTextContent();
                            my %find_attrs = $edit_child->getAttributes();
                            foreach my $attr_name (keys %find_attrs) {
                                if ($attr_name eq 'type'){
                                    $edit_hash{find_type} = $find_attrs{$attr_name};
                                }
                            }
                        }
                        elsif ($edit_child_name eq 'action'){
                            my %action_attrs = $edit_child->getAttributes();
                            foreach my $attr_name (keys %action_attrs) {
                                if ($attr_name eq 'type'){
                                    my $type_name = $action_attrs{$attr_name};
                                    if ($type_name eq 'after-add'){
                                        $edit_hash{action_after_add} = $edit_child->getTextContent();
                                    }
                                    elsif ($type_name eq 'before-add'){
                                        $edit_hash{action_before_add} = $edit_child->getTextContent();
                                    }
                                    elsif ($type_name eq 'replace-with'){
                                        $edit_hash{action_replace_with} = $edit_child->getTextContent();
                                    }
                                }
                            }
                        }
                        elsif ($edit_child_name eq 'inline-edit'){
                            foreach my $ie_child ($edit_child->getChildNodes) {
                                my $ie_name = $ie_child->getNodeName();
                                if ($ie_child->isa('XML::Xerces::DOMElement')){
                                    if ($ie_name eq 'inline-find'){
                                        $edit_hash{inline_find} = $ie_child->getTextContent();
                                        my %find_attrs = $ie_child->getAttributes();
                                        foreach my $attr_name (keys %find_attrs) {
                                            if ($attr_name eq 'type'){
                                                $edit_hash{find_type} = $find_attrs{$attr_name};
                                            }
                                        }
                                    }
                                    elsif ($ie_name eq 'inline-action'){
                                        my %action_attrs = $ie_child->getAttributes();
                                        foreach my $attr_name (keys %action_attrs) {
                                            if ($attr_name eq 'type'){
                                                my $type_name = $action_attrs{$attr_name};
                                                if ($type_name eq 'after-add'){
                                                    $edit_hash{inline_action_after_add} = $ie_child->getTextContent();
                                                }
                                                elsif ($type_name eq 'before-add'){
                                                    $edit_hash{inline_action_before_add} = $ie_child->getTextContent();
                                                }
                                                elsif ($type_name eq 'replace-with'){
                                                    $edit_hash{inline_action_replace_with} = $ie_child->getTextContent();
                                                }
                                            }
                                        }
                                    }
                                }
                            }
                        }
                    }
                }
                push (@edits, \%edit_hash);
            }
        }
    }

    $return_hash{edits} = \@edits;

    return \%return_hash;
}

sub _process_sql{
    my $sql_node = shift;
    my %return_hash;

    my %sql_attrs = $sql_node->getAttributes();
    foreach my $attr_name (keys %sql_attrs) {
        if ($attr_name eq 'dbms'){
            $return_hash{dbms} = $sql_attrs{$attr_name};
        }
    }
    $return_hash{action} = 'sql';
    $return_hash{sql} = $sql_node->getTextContent();

    #process everything as mysql
    #if (defined $return_hash{dbms}){
    #    if ($return_hash{dbms} ne 'mysql'){
    #        _write_log_entry(ERROR, "The only supported database is mysql, can't process SQL statement");
    #        croak "Can't process SQL statement only mysql is supported\n";
    #    }
    #    elsif ($return_hash{dbms} ne $phpbb_config_ref->{dbms}){
    #        _write_log_entry(ERROR, "php DBMS type is different to the SQL statement DBMS type");
    #        croak "php DBMS type is different to the SQL statement DBMS type\n";
    #    }
    #}

    return \%return_hash;
}

sub _process_diy_instructions{
    my $diy_node = shift;

    my %return_hash;
    $return_hash{action} = 'diy-instructions';
    $return_hash{instruction} = $return_hash{instruction} || $diy_node->getTextContent();

    my %child_attrs = $diy_node->getAttributes();
    foreach my $attr_name (keys %child_attrs) {
        if ($attr_name eq 'lang'){
            if ($child_attrs{$attr_name} eq $lang){
                $return_hash{instruction} = $diy_node->getTextContent();
            }
        }
    }

    return \%return_hash;
}

sub _process_uninstall{
    my $instructions_ref = shift;
    my $backup_dir = shift;

    warn ("WARNING: Uninstall not yet implemented\n\n");
    return;

    foreach my $instruction_ref (@{$instructions_ref}){
        if ($instruction_ref->{action} eq 'copy'){
            #phpbb_uninstall_copy_file($instruction_ref, $backup_dir);
        }
        elsif ($instruction_ref->{action} eq 'sql'){
            #phpbb_uninstall_run_sql($instruction_ref);
        }
        elsif ($instruction_ref->{action} eq 'open'){
            #phpbb_uninstall_open_file($instruction_ref);
        }
        elsif ($instruction_ref->{action} eq 'diy-instructions'){
            #phpbb_uninstall_diy_instructions($instruction_ref);
        }
    }
}


sub _process_instructions{
    my $instructions_ref = shift;
    my $backup_dir = shift;

    foreach my $instruction_ref (@{$instructions_ref}){
        if ($instruction_ref->{action} eq 'copy'){
            _phpbb_copy_file($instruction_ref, $backup_dir);
        }
        elsif ($instruction_ref->{action} eq 'sql'){
            _phpbb_run_sql($instruction_ref);
        }
        elsif ($instruction_ref->{action} eq 'open'){
            _phpbb_open_file($instruction_ref);
        }
        elsif ($instruction_ref->{action} eq 'diy-instructions'){
            _phpbb_diy_instructions($instruction_ref);
        }
    }
}

sub _phpbb_copy_file{
    my $instruction_ref = shift;
    my $backup_dir = shift;

    foreach my $file_ref (@{$instruction_ref->{files}}){
        my $to = $file_ref->{to};
        if ( (defined $style) && ($to =~ /^(.*)prosilver(.*)$/) ){
            $to = $1 . $style . $2;
        }
        elsif ( (defined $style) && ($to =~ /^(.*)subsilver2(.*)$/) ){
            $to = $1 . $style . $2;
        }

        my $source      = "$install_absolute_path/" . $file_ref->{from};
        my $destination = "$web_root_absolute_path/" . $to;
        if (index($destination, '*') >= 0){
            $destination = dirname ($destination);
        }
        _write_log_entry(AUDIT, "Copy file: $source to $destination");
        if (-f $destination){
            my $backup_filename = "$backup_dir/" . $to;
            _create_dir_recursive( dirname ($backup_filename) );
            _write_log_entry(DEBUG, "Backup file: $destination to $backup_filename");
            copy ($destination, $backup_filename)
                or croak "Failed to backup $destination\n";
        }
        _create_dir_recursive( dirname ($destination) );
        copy ($source, $destination)
            or croak "Copy failed from $source to $destination\n";
    }
}

sub _phpbb_run_sql{
    my $instruction_ref = shift;
    if ($dbh){
        my $sql = $instruction_ref->{sql};
        $sql =~ s/phpbb_/$phpbb_config_ref->{table_prefix}/g;
        my @statements = split /;/, $sql;
        foreach my $statement (@statements){
            $statement = _trim($statement);
            if (length($statement) > 0){
                _write_log_entry(AUDIT, "Updating database: $statement");
                my $sth;
                eval{$sth = $dbh->prepare($statement)};
                eval{$sth->execute();};
                if ($@){
                    _write_log_entry(ERROR, "Unable to run SQL: '$statement' : " . $dbh->err . " : $@");
                    carp "Database error trying to run SQL. $@\n";
                }
            }
        }
    }
    else{
        _write_log_entry(ERROR, "Cannot update database, no database connection");
        croak "Can't update database, no connection\n";
    }
}

sub _phpbb_open_file{
    my $instruction_ref = shift;

    my $src = $instruction_ref->{src};
    if ( (defined $style) && ($src =~ /^(.*)prosilver(.*)$/) ){
        $src = $1 . $style . $2;
    }
    if ( (defined $style) && ($src =~ /^(.*)subsilver2(.*)$/) ){
        $src = $1 . $style . $2;
    }

    my $file_to_open = "$web_root_absolute_path/$src";
    if (!-f $file_to_open){
        _write_log_entry(ERROR, "File to open '$file_to_open' doesn't exist");
        warn "WARNING: File to open '$file_to_open' doesn't exist\n";
    }
    _write_log_entry(AUDIT, "Opening file '$file_to_open'");
    my $backup_filename = "$backup_dir/" . $src;
    _create_dir_recursive( dirname ($backup_filename) );
    _write_log_entry(DEBUG, "Backup file: $file_to_open to $backup_filename");
    copy ($file_to_open, $backup_filename)
        or croak "Failed to backup $file_to_open\n";

    {
        local( $/, *FH ) ;
        open( FH, '<', $file_to_open ) or croak "Couldn't open file for editing: $!\n";
        my $file_text = ;
        close (FH);

        foreach my $edit_ref (@{$instruction_ref->{edits}}){
            my $find_start = index($file_text, $edit_ref->{find});
            if($find_start >= 0){
                my $find_text = $edit_ref->{find};
                my $pre_text = substr $file_text, 0, $find_start;
                my $post_text = substr $file_text, $find_start + length($find_text);

                if (defined $edit_ref->{inline_find}){
                    my $inline_find_start = index($find_text, $edit_ref->{inline_find});
                    if($inline_find_start >= 0){
                        my $inline_find_text = $edit_ref->{inline_find};
                        my $inline_pre_text = substr $find_text, 0, $inline_find_start;
                        my $inline_post_text = substr $find_text, $inline_find_start + length($inline_find_text);

                        my $already_installed = 0;
                        if (defined $edit_ref->{inline_action_after_add}){
                            if (index($file_text, $inline_find_text . $edit_ref->{inline_action_after_add}) >= 0){
                                $already_installed = 1;
                            }
                        }
                        if (defined $edit_ref->{inline_action_before_add}){
                            if (index($file_text, $edit_ref->{inline_action_before_add} . $inline_find_text) >= 0){
                                $already_installed = 1;
                            }
                        }
                        if($already_installed){
                            _write_log_entry(ERROR, "It looks like the mod has already been applied to $file_to_open");
                            croak "It looks like the mod has already been applied to $file_to_open\n";
                        }

                        if (defined $edit_ref->{inline_action_replace_with}){
                            $inline_find_text = $edit_ref->{inline_action_replace_with};
                        }
                        if (defined $edit_ref->{inline_action_after_add}){
                            $inline_find_text = $inline_find_text . $edit_ref->{inline_action_after_add};
                        }
                        if (defined $edit_ref->{inline_action_before_add}){
                            $inline_find_text = $edit_ref->{inline_action_before_add} . $inline_find_text;
                        }
                        $find_text = $inline_pre_text . $inline_find_text . $inline_post_text;
                    }
                    else{
                        _write_log_entry(ERROR, "Couldn't find the required inline edit: $edit_ref->{inline_find}");
                        warn "WARNING: Inline edit find failed, it must be dealt with manually. $edit_ref->{inline_find}\n";
                    }
                }
                if (defined $edit_ref->{action_replace_with} ||
                    defined $edit_ref->{action_before_add} ||
                    defined $edit_ref->{action_after_add}){

                    #check if the mod has already been applied
                    my $already_installed = 0;
                    if (defined $edit_ref->{action_before_add}){
                        my $action_start = index($file_text, $edit_ref->{action_before_add});
                        if ($action_start >= 0){
                            $already_installed = 1;
                        }
                    }
                    if (defined $edit_ref->{action_after_add}){
                        my $action_start = index($file_text, $edit_ref->{action_after_add});
                        if ($action_start >= 0){
                            $already_installed = 1;
                        }
                    }
                    if($already_installed){
                        _write_log_entry(ERROR, "It looks like the mod has already been applied to $file_to_open");
                        croak "It looks like the mod has already been applied to $file_to_open\n";
                    }

                    if (defined $edit_ref->{action_replace_with}){
                        $find_text = $edit_ref->{action_replace_with};
                    }
                    if (defined $edit_ref->{action_after_add}){
                        $find_text = $find_text . "\n\n" . $edit_ref->{action_after_add} . "\n";
                    }
                    if (defined $edit_ref->{action_before_add}){
                        $find_text = "\n" . $edit_ref->{action_before_add} . "\n\n" . $find_text;
                    }
                }
                $file_text = $pre_text . $find_text . $post_text;

                open (OUT, '>', $file_to_open) or croak "Unable to rewrite file '$file_to_open': $!\n";
                binmode OUT;
                print OUT $file_text;
                close (OUT);
            }
            else{
                _write_log_entry(ERROR, "Couldn't find the required edit: $edit_ref->{find}");
                warn "WARNING: Edit find failed, it must be dealt with manually. $edit_ref->{find}\n";
            }
        }
    }
}

sub _phpbb_diy_instructions{
    my $instruction_ref = shift;
    _write_log_entry(AUDIT, "DIY Instruction: " . $instruction_ref->{instruction});
    print STDOUT "\n\nDIY Instructions:\n" . $instruction_ref->{instruction} . "\n\n";
}


sub _create_dir_recursive{
    my $complete_dir = shift;

    my @file_parts = split /\//, $complete_dir;
    my $curr_dir = '';
    foreach my $file_part (@file_parts){
        $curr_dir .= "$file_part/";
        if (!-d $curr_dir){
            mkdir ($curr_dir) or croak "mkdir failed for '$curr_dir'\n";
        }
    }
}


sub _create_backup_dirs{
    my $working_dir = shift;

    my $backup_dir = "$working_dir/backups";

    if (!-d $backup_dir){
        mkdir ($backup_dir)
            or croak "Can't create backup directory '$backup_dir'\n";
    }

    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst)
        = localtime(time);
    my $curr_time = sprintf "%4d-%02d-%02d_%02d-%02d-%02d", $year+1900,$mon+1,$mday,$hour,$min,$sec;
    my $current_backup_dir = "$backup_dir/$curr_time";

    if (!-d $current_backup_dir){
        mkdir ($current_backup_dir)
            or croak "Can't create backup directory '$current_backup_dir'\n";
    }

    return $current_backup_dir;
}

sub _trim {
    my $txt=shift;
    $_=$txt;
    $txt =~ s/^\s+|\s+$//g ;
    return $txt
}

1;

__END__