#!/usr/bin/perl -w
#
# Zymonic Business Process and Information Management System
# Copyright Zednax Limited 2008 -
# For Authors and Changelog see the subversion history

# error handling
BEGIN
{
    use Zymonic::Utils qw(death_handler clean get_array);
    $main::SIG{__DIE__} = \&death_handler;
}

# Modules
use Zymonic;
use Zymonic::Config;

use HTML::Entities qw(encode_entities_numeric);

$Zymonic::system  = '';
$Zymonic::session = '';

$Zymonic::system = clean( shift @ARGV, '_' ) || '';
my @table_fields =
  map { my @data = split( /\./, $_ ); { table => $data[0], field => $data[1] } } split( /,/, shift @ARGV );
my $fake = shift @ARGV || '';
unless ( $Zymonic::system && @table_fields )
{
    print "Usage: update_db_for_html_fields.pl [system] [table.field, ...] [fake flag]\n"
      . "\t system      - zymonic system to act on\n"
      . "\t table.field - zname of the table and field to update data for, can have multiple entries, comma seperated\n"
      . "\t fake flag   - if set then will output the changes and not update the DB\n";
    exit(0);
}

$Zymonic::ZCONFIG{$Zymonic::system} = Zymonic::Config->new(
    system_name => $Zymonic::system,
    config_dir  => "/etc/zymonic",
    ip_address  => '127.0.0.1',
    protocol    => 'http'
);

my $db = $Zymonic::ZCONFIG{$Zymonic::system}->{DB};
update_table_field( $_->{table}, $_->{field} ) for @table_fields;
exit(0);

# function to update a specific table field
sub update_table_field
{
    my $table_zname = shift;
    my $field_zname = shift;

    # lookup field names and keyfields
    my $table_def = $Zymonic::ZCONFIG{$Zymonic::system}->get_def( 'Table', $table_zname );
    my $field_def = $Zymonic::ZCONFIG{$Zymonic::system}->get_def( 'Field', $field_zname );
    my $table_name = $Zymonic::ZCONFIG{$Zymonic::system}->get_sql_name($table_def);
    my $field_name = $Zymonic::ZCONFIG{$Zymonic::system}->get_sql_name($field_def);
    my @keyfields =
      map { $_->{FieldName}->{content} }
      grep { $_->{UniqueKey} && $_->{UniqueKey}->{content} eq 'true' } get_array( $table_def->{Key} );

    # find records to update
    my $records = $db->run_query(
        {
            string => 'SELECT '
              . join( ', ', @keyfields, $field_name )
              . " FROM $table_name WHERE ($field_name LIKE '%<%>%' OR $field_name LIKE '%&;t;%&gt%') AND $field_name NOT LIKE '%<p>%'",
            params => []
        }
    );
    my $record_count = @{$records};
    print "Updating $field_zname ($field_name) in $table_zname ($table_name) - found $record_count record(s)\n";

    # update each records
    update_table_field_record( $table_name, $field_name, \@keyfields, $_ ) for @{$records};
}

# function to update a specific record fields in a table
sub update_table_field_record
{
    my $table_name = shift;
    my $field_name = shift;
    my $keyfields  = shift;
    my $record     = shift;
    my @keyfields  = @{$keyfields};

    # grab data and find xml within it
    my $data          = $record->{$field_name};
    my $data_with_xml = update_contained_xml($data);
    my $updated_data  = post_process_for_html($data_with_xml);

    # update the record
    if ($fake)
    {
        print "\tUpdated record "
          . join( ', ', map { $_ . ' = ' . $record->{$_} } @keyfields )
          . ":\n\tData:\n$data\n\n\tUpdated:\n$updated_data\n\n---------\n\n";
    }
    else
    {
        if ( $updated_data && $updated_data ne $data )
        {
            my $result = $db->run_statement(
                {
                    string => "UPDATE $table_name SET $field_name = ? WHERE "
                      . join( ' AND ', map { "$_ = ?" } @keyfields ),
                    params => [ $updated_data, map { $record->{$_} } @keyfields ]
                }
            );
            print "\tUpdated record " . join( ', ', map { $_ . ' = ' . $record->{$_} } @keyfields ) . " - $result\n";
        }
    }
}

# function to convert xml into xml with pre tag
sub update_contained_xml
{
    my $data = shift;
    my $recursing = shift || '';

    # some quick checks first
    unless ($recursing)
    {
        # remove <br /> as the <p> will give line breaks
        $data =~ s/<br\s*\/?>//gm;
    }

    my @updated_data_chunks = ();
    if ( $data =~ /(.*)(<.*?>.*<\/.*?>)(.*)/ms )
    {
        # unencoded xml
        my ( $before, $raw_xml, $after ) = ( $1, $2, $3 );

        # xml is unencoded, encode it and wrap in pre tag
        my $xml = '<pre class="prettyprint">' . encode_entities_numeric($raw_xml) . '</pre>';

        # add to list, encoding the before and after parts also
        push(
            @updated_data_chunks,
            update_contained_xml( $before, 'recursing' ),
            $xml, update_contained_xml( $after, 'recursing' )
        );
    }
    elsif ( $data =~ /(.*)(&lt;.*?&gt;.*&lt;\/.*?&gt;)(.*)/ms )
    {
        # encoded xml
        my ( $before, $raw_xml, $after ) = ( $1, $2, $3 );

        # xml is already encoded, so just wrap in pre tag
        my $xml = '<pre class="prettyprint">' . $raw_xml . '</pre>';

        # add to list, encoding the before and after parts also
        push(
            @updated_data_chunks,
            update_contained_xml( $before, 'recursing' ),
            $xml, update_contained_xml( $after, 'recursing' )
        );
    }
    elsif ( $data =~ /(.*)(<[-a-zA-Z="'\._].*[-a-zA-Z="'\._]\/?>)(.*)/ms )
    {
        # unencoded xml tags
        my ( $before, $raw_tags, $after ) = ( $1, $2, $3 );

        # tags are unencoded, encode them and wrap in pre tag
        my $tags = '<pre class="prettyprint">' . encode_entities_numeric($raw_tags) . '</pre>';

        # add to list, encoding the before and after parts also
        push(
            @updated_data_chunks,
            update_contained_xml( $before, 'recursing' ),
            $tags, update_contained_xml( $after, 'recursing' )
        );
    }
    elsif ( $data =~ /(.*)(&lt;[-a-zA-Z="'\._<>].*[-a-zA-Z="'\._<>]\/?&gt;)(.*)/ms )
    {
        # encoded xml tags
        my ( $before, $raw_tags, $after ) = ( $1, $2, $3 );

        # tags are already encoded, so just wrap in pre tag
        my $tags = '<pre class="prettyprint">' . $raw_tags . '</pre>';

        # add to list, encoding the before and after parts also
        push(
            @updated_data_chunks,
            update_contained_xml( $before, 'recursing' ),
            $tags, update_contained_xml( $after, 'recursing' )
        );
    }

    if (@updated_data_chunks)
    {
        return join( "\n", grep { $_ !~ /^<p><\/p>$/m } @updated_data_chunks );
    }
    else
    {
        # remove any excess space
        $data =~ s/^\s*//gm;
        $data =~ s/\s*$//gm;
        return "<p>$data</p>";
    }
}

# function to add helpful HTML snippets
sub post_process_for_html
{
    my $data = shift;

    # convert URLs to links
    $data =~ s/(https?:\/\/.*)(?:[\s<])/<a href="$1">$1<\/a>/gm;

    # check for lists
    if ( my @ul_lists = $data =~ /^(\*\s+[^\*]*)<?$/gms )
    {
        foreach my $i ( 0 .. $#ul_lists )
        {
            # check for any closing tags and remove those
            $ul_lists[$i] =~ s/<\/.*?>$//gms;

            # wrap in list item and remove the old bullet point
            my $replacement = '<li>' . $ul_lists[$i] . "</li>\n";
            $replacement =~ s/\*\s+//gms;

            # surround with ul tags
            if ( $i == 0 )
            {
                $replacement = "<ul>\n$replacement";
            }
            elsif ( $i == $#ul_lists )
            {
                $replacement = "$replacement</ul>\n";
            }

            # add in place
            $data =~ s/\Q$ul_lists[$i]\E/$replacement/;
        }
    }

    return $data;
}