#!/usr/bin/perl -w
#
#                                                               -*- perl -*-
#
#--------------------------------------------------------------------------------------------------------------
# Program       : wallet-history
# Function      : Tool for listing and/or modifying Wallet's object history
# Author        : Commerzbank AG
# History       : 20.01.2014 - V0.1 - First version - maxcrc
#               : 21.01.2014 - V0.2 - Fixed some minor bugs and code formatting - Gerhard Stahl
#				      Added some remarks for nessesary fixes
#               : 29.01.2014 - V0.2 - Fixed issue related to variable comparision of undef values - maxcrc
#				      Reformatted code to use functions like debug, usage - maxcrc
#               : 06.02.2014 - V0.3 - Added support for ACL history in addition to object history - maxcrc
#               : 07.02.2014 - V0.4 - A lot of improvements, run with --help to see - maxcrc
#				      --acl and --obj argument names removed, please use --acls and --objs
#				      --from and --to argument names replaced with --start and --end
#				      Added new filtering args --from, --action, --acl, --by, --type and --name
#				      Added new --version action type
#				      Added new --columns action type
#               : 08.02.2014 - V0.5 - Added support for ACL names via new ah_name column - maxcrc
#
#--------------------------------------------------------------------------------------------------------------
#
# Usage:
#
#  type ./wallet-history with no arguments to get the full help text (or with --help).
#
# In general, use a command of the form:
#
# perl wallet-history.pl ... (t.b.d.)...
#
#--------------------------------------------------------------------------------------------------------------
#
# SPDX-License-Identifier: MIT

# Version.

my $VERSION = "0.5";

=head1 Needed Modules

Here is the list of modules we need:

=cut

use strict;
use Getopt::Long;
use Wallet::Schema;
use DateTime;
use DateTime::Format::Strptime;
#use DBIx::ResultSet;
use DBI;
#use DateTime ();
#use Scalar::Util;

my $debug_on = 0;

=head1 Subroutines

=head2 Utility subroutines

=head3 usage - display a usage message

=cut

sub usage() {
	print "wallet-history is tool for listing and/or modifying Wallet's history\n";
	print "usage:\n";
	print "wallet-history [mandatory action] [optional query type] [optional filtering arguments]\n";
	print "    where mandatory action is one of:\n";
	print "        --help              - display this help information\n";
	print "        --version           - display app version\n";
	print "        --columns           - display column names (use with --objs or --acls)\n";
	print "        --list              - list ACL or object history with/without from/to date filters\n";
	print "        --clear             - clear ACL or object history with/without from/to date filters\n";
	print "    optional query type is one of:\n";
	print "        --acls              - query is for ACL history (default is --objs)\n";
	print "        --objs              - query is for object history (this is default)\n";
	print "    optional filtering data entries by (any [name] can be regular expression):\n";
	print "        --start [date/time] - starting date\n";
	print "        --end   [date/time] - ending date\n";
	print "        --from [name]       - computer name\n";
	print "        --action [name]     - action\n";
	print "        --acl [name]        - acl        (with --acls only)\n";
	print "        --by [name]         - by address (with --acls only)\n";
	print "        --type [name]       - type       (with --objs only)\n";
	print "        --name [name]       - host name with --objs, acl name with --acls\n";
}


=head3 usage - prints debug messages

=cut

sub debug {
	my $msg = @_;
	return unless ( $debug_on == 1);
	print $msg . "\n";
}


my $parser = DateTime::Format::Strptime->new(
	pattern		=> '%Y-%m-%dT%H:%M:%S',
	on_error	=> 'croak',
	);

my $opt_result        = undef;
my $an_action_help    = undef;
my $an_action_version = undef;
my $an_action_columns = undef;
my $an_action_list    = undef;
my $an_action_clear   = undef;
my $is_action_acls    = 0;
my $is_action_objs    = 1;
my $str_date_from     = undef;
my $str_date_to       = undef;
my $str_filter_computer_name = undef;
my $str_filter_action = undef;
my $str_filter_acl    = undef;
my $str_filter_by     = undef;
my $str_filter_type   = undef;
my $str_filter_name   = undef;
	$opt_result = GetOptions (
		  "help"	=> \$an_action_help
		, "version"	=> \$an_action_version
		, "columns"	=> \$an_action_columns
		, "list"	=> \$an_action_list
		, "clear"	=> \$an_action_clear
		, "acls"	=> \$is_action_acls
		, "objs"	=> \$is_action_objs
		, "start=s"	=> \$str_date_from
		, "end=s"	=> \$str_date_to
		, "from=s"	=> \$str_filter_computer_name
		, "action=s"	=> \$str_filter_action
		, "acl=s"	=> \$str_filter_acl
		, "by=s"	=> \$str_filter_by
		, "type=s"	=> \$str_filter_type
		, "name=s"	=> \$str_filter_name
		);

	if( ( defined $an_action_help ) or ( defined $an_action_version ) ) {
		if( defined $an_action_version ) {
			print "wallet-history version is $VERSION\n";
		}
		if( defined $an_action_help ) {
			usage;
		}
		exit 0; # FIN #
	}

my $str_resultset_name = undef;
	if( $is_action_acls ) {
		$is_action_objs = 0;
		$str_resultset_name = 'AclHistory';
	} else {
		$is_action_objs = 1;
		$str_resultset_name = 'ObjectHistory';
	}

	if( defined $an_action_columns ) {
		if( $is_action_acls ) {
			print "\"ah_on\" \"ah_acl\" \"ah_by\" \"ah_action\" \"ah_from\"\n";
		} else { if( $is_action_objs ) {
			print "\"oh_on\" \"oh_by\" \"oh_type\" \"oh_name\" \"oh_action\" \"oh_from\"\n";
		} else {
			die "Critical internal error - unknown dataset type\n";
		} }
		exit 0; # FIN #
	}


my $date_from = undef;
	if ( defined $str_date_from ) {
		$date_from = $parser->parse_datetime( $str_date_from );
		debug "Using minimal(from) date $date_from\n";
	}
my $date_to   = undef;
	if ( defined $str_date_to ) {
		$date_to = $parser->parse_datetime( $str_date_to );
		debug "Using maximal(to) date $date_to\n";
	}

	if ( $an_action_list || $an_action_clear ) {
		my $schema = Wallet::Schema->connect;
		my @data_entries;
		eval {
			my @data_entries_rs = $schema->resultset( $str_resultset_name )->search(); # ( $search_ref, $options_ref );
			for my $entry_rs (@data_entries_rs) {
				if( $is_action_acls ) {
					# begin - working with ACLs history
					my $is_filter_passed = 1;
					my $str_date_on = "" . $entry_rs->ah_on;
					my $date_on = $parser->parse_datetime( $str_date_on );
					debug "date on as string ", $str_date_on, "\n";
					debug "date on as date   ", $date_on, "\n";
					if ( ( defined $date_from ) || ( defined $date_to ) ) {
						if ( ( defined $date_from ) && ( $date_from > $date_on ) ) {
							$is_filter_passed = 0;
						}
						if ( ( defined $date_to ) && ( $date_to < $date_on ) ) {
							$is_filter_passed = 0;
						}
					} # if ( ( defined $date_from ) || ( defined $date_to ) )
					if( $is_filter_passed != 0 && ( defined $str_filter_computer_name ) ) {
						my $str_text_to_test = "" . $entry_rs->ah_from;
						if( not ( $str_text_to_test =~ /$str_filter_computer_name/ ) ) {
							$is_filter_passed = 0;
						}
					} # if( $is_filter_passed != 0 && ( defined $str_filter_computer_name ) )
					if( $is_filter_passed != 0 && ( defined $str_filter_action ) ) {
						my $str_text_to_test = "" . $entry_rs->ah_action;
						if( not ( $str_text_to_test =~ /$str_filter_action/ ) ) {
							$is_filter_passed = 0;
						}
					} # if( $is_filter_passed != 0 && ( defined $str_filter_action ) )
					if( $is_filter_passed != 0 && ( defined $str_filter_acl ) ) {
						my $str_text_to_test = "" . $entry_rs->ah_acl;
						if( not ( $str_text_to_test =~ /$str_filter_acl/ ) ) {
							$is_filter_passed = 0;
						}
					} # if( $is_filter_passed != 0 && ( defined $str_filter_acl ) )
					if( $is_filter_passed != 0 && ( defined $str_filter_by ) ) {
						my $str_text_to_test = "" . $entry_rs->ah_by;
						if( not ( $str_text_to_test =~ /$str_filter_by/ ) ) {
							$is_filter_passed = 0;
						}
					} # if( $is_filter_passed != 0 && ( defined $str_filter_by ) )
					if( $is_filter_passed != 0 && ( defined $str_filter_name ) ) {
						my $str_text_to_test = "" . $entry_rs->ah_name;
						if( not ( $str_text_to_test =~ /$str_filter_name/ ) ) {
							$is_filter_passed = 0;
						}
					} # if( $is_filter_passed != 0 && ( defined $str_filter_name ) )
					if( $is_filter_passed != 0 ) {
						push (@data_entries, [$entry_rs->ah_on, $entry_rs->ah_acl, $entry_rs->ah_by, $entry_rs->ah_action, $entry_rs->ah_from, $entry_rs->ah_name ]);
						debug "Found: \"", $entry_rs->ah_on, "\" \"", $entry_rs->ah_acl, "\" \"", $entry_rs->ah_by, "\" \"", $entry_rs->ah_action, "\" \"", $entry_rs->ah_from, "\" \"", $entry_rs->ah_name, "\n";
					} # if( $is_filter_passed != 0 )
					debug "walked throgh dates \"", ref($date_from), "-", $date_from, "\" \"", ref($date_on), "-", $date_on, "\" \"", ref($date_to), "-", $date_to, "\" result is ", $is_filter_passed, "\n";
					#  end  - working with ACLs history
				} else { if( $is_action_objs ) {
					# begin - working with objects history
					my $is_filter_passed = 1;
					my $str_date_on = "" . $entry_rs->oh_on;
					my $date_on = $parser->parse_datetime( $str_date_on );
					debug "date on as string ", $str_date_on, "\n";
					debug "date on as date   ", $date_on, "\n";
					if ( ( defined $date_from ) || ( defined $date_to ) ) {
						if ( ( defined $date_from ) && ( $date_from > $date_on ) ) {
							$is_filter_passed = 0;
						}
						if ( ( defined $date_to ) && ( $date_to < $date_on ) ) {
							$is_filter_passed = 0;
						}
					} # if ( ( defined $date_from ) || ( defined $date_to ) )
					if( $is_filter_passed != 0 && ( defined $str_filter_computer_name ) ) {
						my $str_text_to_test = "" . $entry_rs->oh_from;
						if( not ( $str_text_to_test =~ /$str_filter_computer_name/ ) ) {
							$is_filter_passed = 0;
						}
					} # if( $is_filter_passed != 0 && ( defined $str_filter_computer_name ) )
					if( $is_filter_passed != 0 && ( defined $str_filter_action ) ) {
						my $str_text_to_test = "" . $entry_rs->oh_action;
						if( not ( $str_text_to_test =~ /$str_filter_action/ ) ) {
							$is_filter_passed = 0;
						}
					} # if( $is_filter_passed != 0 && ( defined $str_filter_action ) )
					if( $is_filter_passed != 0 && ( defined $str_filter_type ) ) {
						my $str_text_to_test = "" . $entry_rs->oh_type;
						if( not ( $str_text_to_test =~ /$str_filter_type/ ) ) {
							$is_filter_passed = 0;
						}
					} # if( $is_filter_passed != 0 && ( defined $str_filter_type ) )
					if( $is_filter_passed != 0 && ( defined $str_filter_name ) ) {
						my $str_text_to_test = "" . $entry_rs->oh_name;
						if( not ( $str_text_to_test =~ /$str_filter_name/ ) ) {
							$is_filter_passed = 0;
						}
					} # if( $is_filter_passed != 0 && ( defined $str_filter_name ) )
					if( $is_filter_passed != 0 ) {
						push (@data_entries, [$entry_rs->oh_on, $entry_rs->oh_by, $entry_rs->oh_type, $entry_rs->oh_name, $entry_rs->oh_action, $entry_rs->oh_from ]);
						debug "Found: \"", $entry_rs->oh_on, "\" \"", $entry_rs->oh_by, "\" \"", $entry_rs->oh_type, "\" \"", $entry_rs->oh_name, "\" \"", $entry_rs->oh_action, "\" \"", $entry_rs->oh_from, "\"", "\n";
					} # if( $is_filter_passed != 0 )
					debug "walked throgh dates \"", ref($date_from), "-", $date_from, "\" \"", ref($date_on), "-", $date_on, "\" \"", ref($date_to), "-", $date_to, "\" result is ", $is_filter_passed, "\n";
					#  end  - working with objects history
				} else {
					die "Critical internal error - unknown dataset type\n";
				} }
			} # for my $entry_rs (@data_entries_rs)
		}; # eval
		if ($@) {
			print "cannot list data entries: $@";
			exit -1;
		}

		if( $is_action_acls ) {
			# begin - working with ACLs history
		 	for my $group (@data_entries) {
				if ( $an_action_clear ) {
					my $is_deleted_ok = 0;
					print "\"", join ("\" \"", @$group), "\" ... ";
					my $sql_delete_error = undef;
					eval {
						my $str_ah_on     = "" . $group->[0];
						my $str_ah_acl    = "" . $group->[1];
						my $str_ah_by     = "" . $group->[2];
						my $str_ah_action = "" . $group->[3];
						my $str_ah_from   = "" . $group->[4];
						my $str_ah_name   = "" . $group->[5];

						my $string  = $str_ah_on; # '01234567890';
						my $find    = 'T';        # '0';
						my $replace = ' ';        # 'a';
						my $pos = index($string, $find);
						while ( $pos > -1 ) {
							substr( $string, $pos, length( $find ), $replace );
							$pos = index( $string, $find, $pos + length( $replace ));
						}
						$str_ah_on = $string;

						debug "Searching \"$str_ah_on\" \"$str_ah_acl\" \"$str_ah_by\" \"$str_ah_action\" \"$str_ah_from\" \"$str_ah_name\" ... \n";

						#my @data_entries_rs =
						#	$schema->resultset('AclHistory')->search( [
						#		  { ah_on     => $str_ah_on     }
						#		, { ah_acl    => $str_ah_acl    }
						#		, { ah_by     => $str_ah_by     }
						#		, { ah_action => $str_ah_action }
						#		, { ah_from   => $str_ah_from   }
						#		, { ah_name   => $str_ah_name   }
						#		] ); # -> delete;

						#my @data_entries_rs =
						#	$schema->resultset('AclHistory')->search( [
						#		  { ah_on     => { '=' , $str_ah_on     } }
						#		, { ah_acl    => { '=' , $str_ah_acl    } }
						#		, { ah_by     => { '=' , $str_ah_by     } }
						#		, { ah_action => { '=' , $str_ah_action } }
						#		, { ah_from   => { '=' , $str_ah_from   } }
						#		, { ah_name   => { '=' , $str_ah_name   } }
						#		] ); # -> delete;

						my $str_sql_del = "DELETE FROM acl_history WHERE ah_on = TO_DATE(\'" . $str_ah_on . "\', 'YYYY-MM-DD HH24:MI:SS') AND ah_acl = \'" . $str_ah_acl . "\' AND ah_by = \'" . $str_ah_by . "\' AND ah_action = \'" . $str_ah_action . "\' AND ah_from = \'" . $str_ah_from . "\' AND ah_name = \'" . $str_ah_name . "\'";

						#$schema->storage->debug(1);
						my @ret = $schema->storage->dbh_do(
							sub {
								my ($storage, $dbh, @args) = @_;
								debug "Attempting to ", $str_sql_del, "\n";
								debug "dbh is ", $dbh, "\n";
								my $sth = $dbh->prepare( $str_sql_del );
								#$sth->{PrintError} = 1;
								#$sth->{RaiseError} = 1;
								debug "sth is ", $sth, "\n";
								my $ret = $sth->execute(); # or die "Can't execute SQL statement: $DBI::errstr\n";
								debug "ret is ", $ret, "\n";
								debug "error string is", $sth->errstr(), "\n";
								if ( $ret == 0 ) {
									$sql_delete_error = "Internal error";
								} else {
									$is_deleted_ok = 1;
								}
							},
							$str_sql_del
							);

						#$is_deleted_ok = 1;

						#for my $entry_rs (@data_entries_rs) {
						#	print "Will delete: \"", $entry_rs->ah_on, "\" \"", $entry_rs->ah_acl, "\" \"", $entry_rs->ah_by, "\" \"", $entry_rs->ah_action, "\" \"", $entry_rs->ah_from, "\"", "\n";
						#} # for my $entry_rs (@data_entries_rs)

					}; # eval
					if ( $is_deleted_ok ) {
						print "Deleted\n";
					} else {
						print "Error ", $sql_delete_error, "\n";
					}
				} else { # else from if ( $an_action_clear )
					print "\"", join ("\" \"", @$group), "\"\n";
				} # else from if ( $an_action_clear )
			} # for my $group (@data_entries)
			#  end  - working with ACLs history
		} else { if( $is_action_objs ) {
			# begin - working with objects history
		 	for my $group (@data_entries) {
				if ( $an_action_clear ) {
					my $is_deleted_ok = 0;
					print "\"", join ("\" \"", @$group), "\" ... ";
					my $sql_delete_error = undef;
					eval {
						my $str_oh_on     = "" . $group->[0];
                                                my $str_oh_by     = "" . $group->[1];
						my $str_oh_type   = "" . $group->[2];
						my $str_oh_name   = "" . $group->[3];
						my $str_oh_action = "" . $group->[4];
						my $str_oh_from   = "" . $group->[5];

						my $string  = $str_oh_on; # '01234567890';
						my $find    = 'T';        # '0';
						my $replace = ' ';        # 'a';
						my $pos = index($string, $find);
						while ( $pos > -1 ) {
							substr( $string, $pos, length( $find ), $replace );
							$pos = index( $string, $find, $pos + length( $replace ));
						}
						$str_oh_on = $string;

						debug "Searching \"$str_oh_on\" \"$str_oh_by\" \"$str_oh_type\" \"$str_oh_name\" \"$str_oh_action\" \"$str_oh_from\" ... \n";

						#my @data_entries_rs =
						#	$schema->resultset('ObjectHistory')->search( [
						#		  { oh_on     => $str_oh_on     }
						#		, { oh_type   => $str_oh_type   }
						#		, { oh_name   => $str_oh_name   }
						#		, { oh_action => $str_oh_action }
						#		, { oh_from   => $str_oh_from   }
						#		] ); # -> delete;

						#my @data_entries_rs =
						#	$schema->resultset('ObjectHistory')->search( [
						#		  { oh_on     => { '=' , $str_oh_on     } }
						#		, { oh_type   => { '=' , $str_oh_type   } }
						#		, { oh_name   => { '=' , $str_oh_name   } }
						#		, { oh_action => { '=' , $str_oh_action } }
						#		, { oh_from   => { '=' , $str_oh_from   } }
						#		] ); # -> delete;

						my $str_sql_del = "DELETE FROM object_history WHERE oh_on = TO_DATE(\'" . $str_oh_on . "\', 'YYYY-MM-DD HH24:MI:SS') AND oh_type = \'" . $str_oh_type . "\' AND oh_name = \'" . $str_oh_name . "\' AND oh_action = \'" . $str_oh_action . "\' AND oh_from = \'" . $str_oh_from . "\'";

						#$schema->storage->debug(1);
						my @ret = $schema->storage->dbh_do(
							sub {
								my ($storage, $dbh, @args) = @_;
								debug "Attempting to ", $str_sql_del, "\n";
								debug "dbh is ", $dbh, "\n";
								my $sth = $dbh->prepare( $str_sql_del );
								#$sth->{PrintError} = 1;
								#$sth->{RaiseError} = 1;
								debug "sth is ", $sth, "\n";
								my $ret = $sth->execute(); # or die "Can't execute SQL statement: $DBI::errstr\n";
								debug "ret is ", $ret, "\n";
								debug "error string is", $sth->errstr(), "\n";
								if ( $ret == 0 ) {
									$sql_delete_error = "Internal error";
								} else {
									$is_deleted_ok = 1;
								}
							},
							$str_sql_del
							);

						#$is_deleted_ok = 1;

						#for my $entry_rs (@data_entries_rs) {
						#	print "Will delete: \"", $entry_rs->oh_on, "\" \"", $entry_rs->oh_type, "\" \"", $entry_rs->oh_name, "\" \"", $entry_rs->oh_action, "\" \"", $entry_rs->oh_from, "\"", "\n";
						#} # for my $entry_rs (@data_entries_rs)

					}; # eval
					if ( $is_deleted_ok ) {
						print "Deleted\n";
					} else {
						print "Error ", $sql_delete_error, "\n";
					}
				} else { # else from if ( $an_action_clear )
					print "\"", join ("\" \"", @$group), "\"\n";
				} # else from if ( $an_action_clear )
			} # for my $group (@data_entries)
			#  end  - working with objects history
		} else {
			die "Critical internal error - unknown dataset type\n";
		} }

		exit 0; # FIN #
	} # if ( $an_action_list || $an_action_clear )

	usage;
	exit 0; # FIN #