package UI::Dialog::Backend;
###############################################################################
#  Copyright (C) 2004  Kevin C. Krinke <kckrinke@opendoorsoftware.com>
#
#  This library is free software; you can redistribute it and/or
#  modify it under the terms of the GNU Lesser General Public
#  License as published by the Free Software Foundation; either
#  version 2.1 of the License, or (at your option) any later version.
#
#  This library is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#  Lesser General Public License for more details.
#
#  You should have received a copy of the GNU Lesser General Public
#  License along with this library; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
###############################################################################
use 5.006;
use strict;
use Carp;
use Cwd qw( abs_path );
use File::Basename;
use Text::Wrap qw( wrap );

BEGIN {
    use vars qw($VERSION);
    $VERSION = '1.08';
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Constructor Method
#:

#: not even really necessary as this class is inherited, and the constructor is
#: more often than not overridden by the backend inheriting it.
sub new {
    my $proto = shift();
    my $class = ref($proto) || $proto;
    my $cfg = ((ref($_[0]) eq "HASH") ? $_[0] : (@_) ? { @_ } : {});
    my $self = { '_opts' => $cfg };
    bless($self, $class);
    return($self);
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Accessory Methods
#:

#: Provide the API interface to nautilus
sub nautilus {
    my $self = $_[0];
    my $nautilus = $self->{'_nautilus'} || {};
    unless (ref($nautilus) eq "UI::Dialog::Backend::Nautilus") {
		if ($self->_find_bin('nautilus')) {
			if (eval "require UI::Dialog::Backend::Nautilus; 1") {
				require UI::Dialog::Backend::Nautilus;
				$self->{'_nautilus'} = new UI::Dialog::Backend::Nautilus;
			}
		}
    }
    return($self->{'_nautilus'});
}

#: Provide the API interface to osd_cat (aka: xosd)
sub xosd {
    my $self = shift();
    my @args = (@_ %2 == 0) ? (@_) : ();
    my $xosd = $self->{'_xosd'} || {};
    unless (ref($xosd) eq "UI::Dialog::Backend::XOSD") {
		if ($self->_find_bin('osd_cat')) {
			if (eval "require UI::Dialog::Backend::XOSD; 1") {
				require UI::Dialog::Backend::XOSD;
				$self->{'_xosd'} = new UI::Dialog::Backend::XOSD (@args);
			}
		}
    }
    return($self->{'_xosd'});
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: State Methods
#:

#: enable altering of attributes
sub attr {
    my $self = $_[0];
    my $name = $_[1];
    unless ($_[2]) {
		return($self->{'_opts'}->{$name}) unless not $self->{'_opts'}->{$name};
		return(undef());
    }
    if ($_[2] == 0 || $_[2] =~ /^NULL$/i) {
		$self->{'_opts'}->{$name} = 0;
    } else {
		$self->{'_opts'}->{$name} = $_[2];
    }
    return($self->{'_opts'}->{$name});
}

#: return the last response data as an ARRAY
sub ra {
    my $self = shift();
    $self->_debug((join(" | ",(caller())))." > ra() > rset: ".((@_) ? "@_" : 'NULL'),3);
    $self->{'_state'}->{'ra'} = ($_[0] =~ /^null$/i) ? [ 0 ] : [ @_ ] unless not @_;
    my $aref = $self->{'_state'}->{'ra'};
	ref($aref) eq "ARRAY" or $aref = [];
    return(@{$aref});
}

#: return the last response data as a SCALAR
sub rs {
    my $self = shift();
    my $rset = $_[0];
    $self->_debug((join(" | ",(caller())))." > rs() > rset: ".(($rset) ? $rset : 'NULL'),3);
    $self->{'_state'}->{'rs'} = ($rset =~ /^null$/i) ? 0 : $rset unless not $rset;
    return($self->{'_state'}->{'rs'});
}

#: return the last exit code as a SCALAR
sub rv {
    my $self = shift();
    my $rset = $_[0];
    $self->_debug((join(" | ",(caller())))." > rv() > rset: ".(($rset) ? $rset : 'NULL'),3);
    $self->{'_state'}->{'rv'} = ($rset =~ /^null$/i) ? '0' : $rset unless not $rset;
    return($self->{'_state'}->{'rv'});
}

#: report on the state of the last dialog variant execution.
sub state {
    my $self = shift();
    my $rv = $self->rv() || 0;
    $self->_debug((join(" | ",(caller())))." > state() > is: ".($rv||'NULL'),2);
    if ($rv == 1 or $rv == 129) {
		return("CANCEL");
    } elsif ($rv == 2) {
		return("HELP");
    } elsif ($rv == 3) {
		return("EXTRA");
    } elsif ($rv == 254) {
		return("ERROR");
    } elsif ($rv == 255) {
		return("ESC");
    } elsif (not $rv or $rv =~ /^null$/i) {
		return("OK");
    } else {
		return("UNKNOWN(".$rv.")");
    }
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Execution Methods
#:

#: execute a simple command (return the exit code only);
sub command_state {
    my $self = $_[0];
    my $cmnd = $_[1];
    $self->_debug("command: ".$cmnd,1);
    system($cmnd . " 2>&1 > /dev/null");
    my $rv = $? >> 8;
    $self->_debug("command rv: ".$rv,2);
    return($rv);
}

#: execute a command and return the exit code and one-line SCALAR
sub command_string {
    my $self = $_[0];
    my $cmnd = $_[1];
    $self->_debug("command: ".$cmnd,1);
    chomp(my $text = `$cmnd 2>&1`);
    my $rv = $? >> 8;
    $self->_debug("command rs: ".$rv." '".$text."'",2);
    return($text) unless defined wantarray;
    return (wantarray) ? ($rv,$text) : $text;
}

#: execute a command and return the exit code and ARRAY of data
sub command_array {
    my $self = $_[0];
    my $cmnd = $_[1];
    $self->_debug("command: ".$cmnd,1);
    chomp(my $text = `$cmnd 2>&1`);
    my $rv = $? >> 8;
    $self->_debug("command ra: ".$rv." '".$text."'",2);
    return([split(/\n/,$text)]) unless defined wantarray;
    return (wantarray) ? ($rv,[split(/\n/,$text)]) : [split(/\n/,$text)];
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Utility Methods
#:


#: make some noise
sub beep {
    my $self = $_[0];
    return($self->_beep(1));
}

#: Clear terminal screen.
sub clear {
    my $self = $_[0];
    return($self->_clear(1));
}

# word-wrap a line
sub word_wrap {
    my $self = shift();
    my $width = shift() || 65;
    my $indent = shift() || "";
    my $sub_indent = shift() || "";
    $Text::Wrap::columns = $width;
    my @strings = wrap($indent, $sub_indent, @_);
    return(@strings);
}

# generate a temporary file name
sub gen_tempfile_name {
    my $self = $_[0];
    my $template = $self->{'_opts'}->{'tempfiletemplate'} || "UI_Dialog_tempfile_XXXXX";
    if (eval("require File::Temp; 1")) {
		use File::Temp qw( tempfile );
		my ($fh,$filename) = tempfile( UNLINK => 1 ) or croak( "Can't create tempfile: $!" );
		return($filename) unless wantarray;
		return($fh,$filename);
    } else {
		my $mktemp = $self->_find_bin('mktemp');
		if ($mktemp && -x $mktemp) {
			chomp(my $tempfile = `$mktemp "$template"`);
			return($tempfile);
		} else {
			#pseudo-random filename coming up!
			my $tempdir = "/tmp";
			unless (-d $tempdir) {
				if (-d "/var/tmp") {
					$tempdir = "/var/tmp";
				} else {
					$tempdir = ".";
				}
			}
			$self->gen_random_string(5);
			my $tempfile = "UI_Dialog_tempfile_".$self->gen_random_string(5);
			while (-e $tempdir."/".$tempfile) {
				$self->gen_random_string(5);
				$tempfile = "UI_Dialog_tempfile_".$self->gen_random_string(5);
			}
			return($tempdir."/".$tempfile);
		}
    }
}

# generate a random string as a (possibly) suitable failover option in the
# event that File::Temp is not installed and the 'mktemp' program does not
# exist in the path.
sub gen_random_string {
    my $self = $_[0];
    my $length = $_[1] || 5;
    my $string = "";
    my $counter = 0;
    while ($counter < $length) {
		# 33 - 127
		my $num = rand(128);
		while ($num < 33 or $num > 127) { $num = rand(128); }
		$string .= chr($num);
		$counter++;
    }
    return($string);
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Widget Wrapping Methods
#:

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: file select
sub fselect {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);

    $self->rv('NULL');
    $self->rs('NULL');
    $self->ra('NULL');

    $self->_beep($args->{'beepbefore'});

    my $cwd = abs_path();
    $args->{'path'} ||= abs_path();
    my $path = $args->{'path'};
    if (!$path || $path =~ /^(\.|\.\/)$/) { $path = $cwd; }
    my $file;
    my ($menu,$list) = ([],[]);
  FSEL: while ($self->state() ne "ESC" && $self->state() ne "CANCEL") {
		my $entries = ($args->{'dselect'}) ? ['[new directory]'] :  ['[new file]'];
		($menu, $list) = $self->_list_dir($path,$entries);
		$file = $self->menu(height=>$args->{'height'},width=>$args->{'width'},listheight=>($args->{'listheight'}||$args->{'menuheight'}),
							title=>$args->{'title'},text=>$path,list=>$menu);
		if ($self->state() eq "CANCEL") {
			$self->rv(1);
			$self->rs('NULL');
			$self->ra('NULL');
			last FSEL;
		} elsif ($file ne "") {
			if ($list->[($file - 1 || 0)] =~ /^\[(new\sdirectory|new\sfile)\]$/) {
				my $nfn;
				while (!$nfn || -e $path."/".$nfn) {
					$nfn = $self->inputbox(height=>$args->{'height'},width=>$args->{'width'},title=>$args->{'title'},
										   text=>'Enter a name (will have a base directory of: '.$path.')');
					next FSEL if $self->state() eq "ESC" or $self->state() eq "CANCEL";
					if (-e $path."/".$nfn) { $self->msgbox(title=>'error',text=>$path."/".$nfn.' already exists! Choose another name please.'); }
				}
				$file = $path."/".$nfn;
				$file =~ s!/$!! unless $file =~ m!^/$!;
				$file =~ s!/\./!/!g; $file =~ s!/+!/!g;
				last FSEL;
			} elsif ($list->[($file - 1 || 0)] eq "../") {
				$path = dirname($path);
			} elsif ($list->[($file - 1 || 0)] eq "./") {
				$file = $path;
				$file =~ s!/$!! unless $file =~ m!^/$!;
				$file =~ s!/\./!/!g; $file =~ s!/+!/!g;
				last FSEL;
			} elsif (-d $path."/".$list->[($file - 1 || 0)]) {
				$path = $path."/".$list->[($file - 1 || 0)];
			} elsif (-e $path."/".$list->[($file - 1 || 0)]) {
				$file = $path."/".$list->[($file - 1 || 0)];
				$file =~ s!/$!! unless $file =~ m!^/$!;
				$file =~ s!/\./!/!g; $file =~ s!/+!/!g;
				last FSEL;
			}
		}
		$file = undef();
		$path =~ s!(/*)!/!; $path =~ s!/\./!/!g;
    }
    $self->_beep($args->{'beepafter'});
    my $rv = $self->rv();
    $self->ra('NULL');
    if ($rv && $rv >= 1) {
		$self->rs('NULL');
		return(0);
    } else {
		$self->rs($file);
		return($file);
    }
}

#:+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#: directory selection
sub dselect {
    my $self = shift();
    my $caller = (caller(1))[3] || 'main';
    $caller = ($caller =~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((caller(2))[3]||'main') : $caller;
    if ($_[0] && $_[0] eq 'caller') { shift(); $caller = shift(); }
    my $args = $self->_pre($caller,@_);
    my $dirname;
    $self->rv('NULL');
    $self->rs('NULL');
    $self->ra('NULL');
    while (not $dirname && $self->state() !~ /^(CANCEL|ESC|ERROR)$/) {
		$dirname = $self->fselect(@_,'dselect',1);
		if ($self->state() =~ /^(CANCEL|ESC|ERROR)$/) {
			return(0);
		}
		unless (not $dirname) {
			# if it's a directory or not exist (assume new dir)
			unless (-d $dirname || not -e $dirname) {
				$self->msgbox( text => $dirname . " is not a directory.\nPlease select a directory." );
				$dirname = undef();
			}
		}
    }
    return($dirname||'');
}


#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#: Backend Methods
#:

sub _pre {
    my $self = shift();
    my $caller = shift();
    my $args = $self->_merge_attrs(@_);
    $args->{'caller'} = $caller;
    my $class = ref($self);

    my $CODEREFS = $args->{'callbacks'};
    if (ref($CODEREFS) eq "HASH") {
		my $PRECODE = $CODEREFS->{'PRE'};
		if (ref($PRECODE) eq "CODE") {
			&$PRECODE($args,$self->state());
		}
    }

    $self->_beep($args->{'beepbefore'});
    $self->_clear($args->{'clearbefore'});
    return($args);
}

sub _post {
    my $self = shift();
    my $args = shift() || {};
    my $class = ref($self);

    $self->_beep($args->{'beepafter'});
    $self->_clear($args->{'clearafter'});

    my $CODEREFS = $args->{'callbacks'};
    if (ref($CODEREFS) eq "HASH") {
		my $state = $self->state();
		if ($state eq "OK") {
			my $OKCODE = $CODEREFS->{'OK'};
			if (ref($OKCODE) eq "CODE") {
				&$OKCODE($args);
			}
		} elsif ($state eq "ESC") {
			my $ESCCODE = $CODEREFS->{'ESC'};
			if (ref($ESCCODE) eq "CODE") {
				&$ESCCODE($args);
			}
		} elsif ($state eq "CANCEL") {
			my $CANCELCODE = $CODEREFS->{'CANCEL'};
			if (ref($CANCELCODE) eq "CODE") {
				&$CANCELCODE($args);
			}
		}
		my $POSTCODE = $CODEREFS->{'POST'};
		if (ref($POSTCODE) eq "CODE") {
			&$POSTCODE($args,$state);
		}
    }

    return(1);
}

#: merge the arguments with the default attributes, and arguments override defaults.
sub _merge_attrs {
    my $self = shift();
    my $args = (@_ % 2) ? { @_, '_odd' } : { @_ };
    my $defs = $self->{'_opts'};
    foreach my $def (keys(%$defs)) {
		$args->{$def} = $defs->{$def} unless $args->{$def};
    }
    # alias 'filename' and 'file' to path
    $args->{'path'} = (($args->{'filename'}) ? $args->{'filename'} :
					   ($args->{'file'}) ? $args->{'file'} :
					   ($args->{'path'}) ? $args->{'path'} : "");

    if ($args->{'title'} && length($args->{'title'})) {
		$args->{'title'} = $self->_esc_text($args->{'title'});
    }
    if ($args->{'backtitle'} && length($args->{'backtitle'})) {
		$args->{'backtitle'} = $self->_esc_text($args->{'backtitle'});
    }
	#     if ($args->{'text'} && length($args->{'text'})) {
	# 	my $text = $args->{'text'};
	# 	if (ref($text) eq "ARRAY") {
	# 	    $args->{'text'} = $self->_esc_text_array($args->{'text'});
	# 	} else {
	# 	    $args->{'text'} = $self->_esc_text($args->{'text'});
	# 	}
	#     }
    if ($args->{'list'} && length($args->{'list'})) {
		my $list = $args->{'list'};
		if (ref($list) eq "ARRAY") {
			my $total = @{$list};
			for (my $i = 0; $i < $total; $i++) {
				my $elem = $list->[$i];
				if (ref($elem) eq "ARRAY") {
					my $elem_total = @{$elem};
					for (my $j = 0; $j < $elem_total; $j++) {
						$elem->[$j] = $self->_esc_text($elem->[$j]);
					}
				} else {
					$list->[$i] = $self->_esc_text($list->[$i]);
				}
			}
		} else {
			$args->{'list'} = $self->_esc_text($args->{'list'});
		}
    }
    $args->{'clear'} = $args->{'clearbefore'} || $args->{'clearafter'} || $args->{'autoclear'} || 0;
    $args->{'beep'} = $args->{'beepbefore'} || $args->{'beepafter'} || $args->{'autobeep'} || 0;
    return($args);
}

#: search through the given paths for a specific variant
sub _find_bin {
    my $self = $_[0];
    my $variant = $_[1];
    $self->{'PATHS'} = ((ref($self->{'PATHS'}) eq "ARRAY") ? $self->{'PATHS'} :
						($self->{'PATHS'}) ? [ $self->{'PATHS'} ] :
						[ '/bin', '/usr/bin', '/usr/local/bin', '/opt/bin' ]);
    foreach my $PATH (@{$self->{'PATHS'}}) {
		return($PATH . '/' . $variant)
		 unless not -x $PATH . '/' . $variant;
    }
    return(0);
}

#: clean the text arguments of all colour codes, alignments and attributes.
sub _strip_text {
    my $self = $_[0];
    my $text = $_[1];
    $text =~ s!\\Z[0-7bBuUrRn]!!gmi;
    $text =~ s!\[[AC]=\w+\]!!gmi;
    $text =~ s!\[/?[BURN]\]!!gmi;
    return($text);
}
sub _esc_text {
    my $self = $_[0];
    my $text = $_[1];
    unless (ref($text)) {
		$text =~ s!\"!\\"!gm;
		$text =~ s!\`!\\`!gm;
		$text =~ s!\(!\(!gm;
		$text =~ s!\)!\)!gm;
		$text =~ s!\[!\[!gm;
		$text =~ s!\]!\]!gm;
		$text =~ s!\{!\{!gm;
		$text =~ s!\}!\}!gm;
		$text =~ s!\$!\\\$!gm;
		$text =~ s!\>!\>!gm;
		$text =~ s!\<!\<!gm;
    }
    return($text);
}

#: indent and organize the text argument
sub _organize_text {
    my $self = $_[0];
    my $text = $_[1] || return();
    my $width = $_[2] || 65;
    my @array;

    if (ref($text) eq "ARRAY") { push(@array,@{$text}); }
    elsif ($text =~ /\\n/) { @array = split(/\\n/,$text); }
    else { @array = split(/\n/,$text); }
    $text = undef();

    @array = $self->word_wrap($width,"","",@array);
    my $max = @array;
    for (my $i = 0; $i < $max; $i++) { $array[$i] = $self->_esc_text($array[$i]); }

    if ($self->{'scale'}) {
		foreach my $line (@array) {
			my $s_line = $self->__TRANSLATE_CLEAN($line);
			$s_line =~ s!\[A\=\w+\]!!gi;
			$self->{'width'} = length($s_line) + 5
			 if ($self->{'width'} - 5) < length($s_line)
			  && (length($s_line) <= $self->{'max-scale'});
		}
    }
    foreach my $line (@array) {
		my $pad;
		my $s_line = $self->_strip_text($line);
		if ($line =~ /\[A\=(\w+)\]/i) {
			my $align = $1;
			$line =~ s!\[A\=\w+\]!!gi;
			if (uc($align) eq "CENTER" || uc($align) eq "C") {
				#		$pad = ((($self->{'_opts'}->{'width'} - 5) - length($s_line)) / 2);
				$pad = (($self->{'_opts'}->{'width'} - length($s_line)) / 2);
			} elsif (uc($align) eq "LEFT" || uc($align) eq "L") {
				$pad = 0;
			} elsif (uc($align) eq "RIGHT" || uc($align) eq "R") {
				#		$pad = (($self->{'_opts'}->{'width'} - 5) - length($s_line));
				$pad = (($self->{'_opts'}->{'width'}) - length($s_line));
			}
		}
		if ($pad) { $text .= (" " x $pad).$line."\n"; }
		else { $text .= $line."\n"; }
    }
    $text = $self->_strip_text($text);
    chomp($text);
    return($text);
}

#: is this a BSD system?
sub _is_bsd {
    my $self = shift();
    return(1) if $^O =~ /bsd/i;
    return(0);
}

#: gather a list of the contents of a directory and return it in
#: two forms, one is the "simple" list of all the filenames and the
#: other is a 'menu' list corresponding to the simple list.
sub _list_dir {
    my $self = shift();
    my $path = shift() || return();
    my $pref = shift();
    my (@listing,@list);
    if (opendir(GETDIR,$path)) {
		my @dir_data = readdir(GETDIR);
		closedir(GETDIR);
		if ($pref) { push(@listing,@{$pref}); }
		foreach my $dir (sort(grep { -d $path."/".$_ } @dir_data)) { push(@listing,$dir."/"); }
		foreach my $item (sort(grep { !-d $path."/".$_ } @dir_data)) { push(@listing,$item); }
		my $c = 1;
		foreach my $item (@listing) { push(@list,"$c",$item); $c++; }
		return(\@list,\@listing);
    } else {
		return("failed to read directory: ".$path);
    }
}

sub _debug {
    my $self = $_[0];
    my $mesg = $_[1] || 'null debug message given!';
    my $rate = $_[2] || 1;
    return() unless $self->{'_opts'}->{'debug'} and $self->{'_opts'}->{'debug'} >= $rate;
    chomp($mesg);
    print STDERR "Debug: ".$mesg."\n";
}
sub _error {
    my $self = $_[0];
    my $mesg = $_[1] || 'null error message given!';
    chomp($mesg);
    print STDERR "Error: ".$mesg."\n";
}

#: really make some noise
sub _beep {
    my $self = $_[0];
    my $beep = $_[1];
    unless (not $beep) {
		if (-x $self->{'_opts'}->{'beepbin'}) {
			return(eval { system($self->{'_opts'}->{'beepbin'}); 1; });
		} else {
			return (1) unless $ENV{'TERM'} && $ENV{'TERM'} ne "dumb";
			print STDERR "\a";
		}
    }
    return(1);
}

#: The actual clear action.
sub _clear {
    my $self = $_[0];
    my $clear = $_[1] || 0;
    # Useless with GUI based variants so we return here.
    # Is the use of the "dumb" TERM appropriate? need feedback.
    return (1) unless $ENV{'TERM'} && $ENV{'TERM'} ne "dumb";
    unless (not $clear and not $self->{'_opts'}->{'autoclear'}) {
		$self->{'_clear'} ||= `clear`;
		print STDOUT $self->{'_clear'};
    }
    return(1);
}



1;