OEF/bin/oedit.pl

#!/usr/bin/perl

##    --------------------------------------------------------------------------------
##    $Id: oedit.pl,v 1.10 2002/12/19 03:49:53 cvsmax Exp $
##    --------------------------------------------------------------------------------
##    $Log: oedit.pl,v $
##    Revision 1.10  2002/12/19 03:49:53  cvsmax
##    + refactored to new structure (e.g. $process->load())
##    o some bugs caused by that still not fixed!!
##
##    Revision 1.9  2002/12/11 07:18:56  cvsjoko
##    - reversed to r1.7
##    - '--cli'-code goes to cli.pl
##
##    Revision 1.7  2002/12/06 22:34:21  cvsjoko
##    + purged code using old object-hierarchy
##
##    Revision 1.6  2002/12/03 15:41:28  cvsmax
##    + added _getClassInfo(), cause Helper::Common doesn't exists anymore
##
##    Revision 1.5  2002/12/03 05:40:15  cvsjoko
##    + bugfix regarding new object hierarchy
##
##    Revision 1.4  2002/11/28 00:39:37  cvsmax
##    + bugfix: changed 'saveObject' to save the object not a hash
##
##    Revision 1.2  2002/11/17 08:43:09  cvsmax
##    + new boot concept
##
##    Revision 1.1  2002/11/17 04:44:25  cvsmax
##    + added new  Object Editor
##
##
##    --------------------------------------------------------------------------------

use strict;
use warnings;
use locale;
use Locale::gettext;

use attributes;
use Data::Dumper;
use IPC::Run qw( run timeout pump timer start finish );


#------- locales ----------
# Import locale-handling tool set from POSIX module.


# This example uses: setlocale -- the function call
#                    LC_CTYPE -- explained below
use POSIX qw(locale_h);

# query and save the old locale
my $old_locale = setlocale(LC_CTYPE);

setlocale(LC_CTYPE, "de_DE.UTF-8");
# LC_CTYPE now in locale "German UTF-8"

#setlocale(LC_CTYPE, "");
# LC_CTYPE now reset to default defined by LC_ALL/LC_CTYPE/LANG
# environment variables. 

# Get some of locale's numeric formatting parameters
my ($thousands_sep, $grouping) = @{localeconv()}{'thousands_sep', 'grouping'};

# Apply defaults if values are missing
$thousands_sep = ',' unless $thousands_sep;
$grouping = 3 unless $grouping;

# Format command line params for current locale
for (@ARGV) {
    $_ = int;    # Chop non-integer part
    1 while
    s/(\d)(\d{$grouping}($|$thousands_sep))/$1$thousands_sep$2/;
    printf "$_";
}
print "\n";

#setlocale(LC_MESSAGES, "de_DE");
#textdomain("my program");
#print gettext("Welcome to my program"), "\n";
#exit;

# dependency startup
BEGIN { 
#  $ENV{SUBDIR_LEVEL} = 1;
  use FindBin;
  use lib "$FindBin::RealBin";
  require 'use_libs.pl';
}

use BizWorks::Boot qw( $bizWorks $bizProcess );
#use Helper::Common;

my $boot = BizWorks::Boot->new();

$bizProcess->load('Core');
$bizProcess->load('App/Payment');


# get logger instance
my $logger = Log::Dispatch::Config->instance;

use Curses;
use Curses::UI;
use Curses::UI::Window;
use Curses::UI::Common;
use vars qw(@ISA);
@ISA = qw(Curses::UI::Common);


# Load an initial file if an argument given on the command line.
# If the file can't be found, assume that this is a new file.
#
my $text = "";
my $currentfile = shift;
my $editor;
my $focused_win;
my @windows= ();
#my %logwin;
#my %textwin;
#my %label;
#my %eObject_win;

#if (defined $currentfile and -f $currentfile) 
#{
#       open F, "<$currentfile" or die "Can't read $currentfile: $!\n";
#       while (<F>) { $text .= $_ }
#       $currentfile = $currentfile;
#       close F;
#}

# We don't want STDERR output to clutter the screen.
#
# Hint: If you need STDERR, write it out to a file and put 
# a tail on that file to see the STDERR output. Example:
#open STDERR, ">>/tmp/editor_errors.$$";
open STDERR, ">>/tmp/gui_status";

# ----------------------------------------------------------------------
# Menu definition
# ----------------------------------------------------------------------

my @menu = (
  { -label => 'Main', 
    -submenu => [
      { -label => 'Run Command  ^R', -value => \&command_dialog  },
      { -label => 'Test', -value => \&test  },
      { -label => 'Exit         ^Q', -value => \&exit_dialog  },
    ]
  },
  { -label => 'Databases', 
    -submenu => [
      { -label => 'Backend', -submenu => [
        { -label => 'retreat', -value => \&retreat_backend  },
        { -label => 'deploy', -value => \&deploy_backend  },
        { -label => 'load resources', -value => \&feed_backend  },
        { -label => 'reset (All above!)', -value => \&reset_backend  },
        ],
      },
    ]
  },
  { -label => 'Objects', 
    -submenu => [
      { -label => 'Edit Object',
        -submenu => [
              { -label => 'by Id', -value => \&editOid_dialog },
              { -label => 'by filter', -value => \&editOfilter_dialog },
            ],
      },
      { -label => 'List Transactions',
            -submenu => [
              { -label => 'all', -value => sub { listTransactions(); } },
              { -label => 'all transfered', -value => sub { listTransactions('transfered'); } },
              { -label => 'all opened', -value => sub { listTransactions('opened'); } },
              { -label => 'all finished', -value => sub { listTransactions('finished'); } },
            ],
      },
    ]
  },
  { -label => 'Editor', 
    -submenu => [
      { -label => 'Start Editor ^E', -value => \&start_editor  },
      { -label => 'Quit Editor ^W', -value => \&close_win  },
      { -label => 'Open file ^O', -value => \&file_open_dialog  },
      { -label => 'Save file ^S', -value => \&file_save_dialog  },
    ]
  },
  { -label => 'Help', 
    -submenu => [
      { -label => 'About', -value => \&about_dialog }
    ]
  } 
);

# ----------------------------------------------------------------------
# Create basic widgets
# ----------------------------------------------------------------------

# Create the root. Everything else will be built up from here.
my $cui = new Curses::UI ( 
        -clear_on_exit => 1 
);


# Add the menu to the root.
my $menu = $cui->add(
        'menu','Menubar', 
        -menu => \@menu,
);


# Help information for the user. 
my $status_win = $cui->add(
        'Status_win', 'Window',
  -border => 1,
        -y               => -1,
        -width           => -1,
        -height          => 3,
  );
my $status = $status_win->add(
        'status', 'Label',
#       -y               => -1,
#       -width           => -1,
#       -height          => 3,
        -reverse         => 1,
        -paddingspaces   => 1,
#  -padright => 8,
        -text            => 
              " ^Q Quit from the program"
            . " ^W Close current window"
            . " ^X Open the menu"
            . " ^R Runs command",
  );

# ----------------------------------------------------------------------
# Callback routines
# ----------------------------------------------------------------------

#--------- callback: Dialog for Object by ID Selection
sub editOid_dialog {
    my $eoid_dialog = $cui->add(
      'EditOid_dialog','Window',
      -centered => 1,
      -width => 60, 
        -height => 10,
        -border => 1,
        -title => "Type Object ID:",
        -onfocus => sub{
            $focused_win = 'EditOid_dialog';
            $status->text("Status: Focus to " . 'EditOid_dialog');
        },
    );
    
    my $textentry = $eoid_dialog->add(
        'eoid_textentry', 'TextEntry',
        -singleline => 1,
        -maxlength => 50,
        -border => 1,
        -centered => 1,
    );
    my $button = $eoid_dialog->add(
      'eoid_button', 'Buttonbox',
      -buttons => [
        {
          -label=> '< OK >',
                -onpress =>  sub { 
                _editObject($textentry->get());
                $cui->delete("EditOid_dialog");
                },
        },
        {
          -label=> '< CANCEL >',
                -onpress =>  \&close_win,
        }
       ],
      -buttonalignment => 'center',
      -x => 20,
      -y => -1,
    );

    $textentry->focus();
    push(@windows, 'EditOid_dialog');
  
}

#----------- callback: Dialog for Objects Selection
sub editOfilter_dialog {

  my @object_names = Class::Tangram::known_classes();
  my %concret_names;
  my @okeys;
  my $o_cnt;
  foreach(sort @object_names) {
    $concret_names{$o_cnt} = $_  if (!Class::Tangram::class_is_abstract($_));
    push @okeys, $o_cnt  if (!Class::Tangram::class_is_abstract($_));
    $o_cnt++;
  }
  
  my %field_names;
  my @fkeys;


    my $eofilter_dialog = $cui->add(
      'EditOfilter_dialog','Window',
      -centered => 1,
      -width => 60, 
        -height => 20,
        -border => 1,
        -title => "Type Object-Filter values:",
        -onfocus => sub{
            $focused_win = 'EditOfilter_dialog';
            $status->text("Status: Focus to " . 'EditOfilter_dialog');
        },
    );
    
             
    $eofilter_dialog->add(
          'eofilter:type_label', 'Label',
          -x => 1,
          -y => 1,
          -text => 'Object Type:',
    );
    my $type_list = $eofilter_dialog->add(
      'eofilter:type_list', 'Popupmenu',
      -x => 15,
      -y => 1,
      -values     => \@okeys,
      -labels     => \%concret_names,
      -width      => 25,
      -onchange   => sub {
          my $pm = shift;
                my $lbl = $pm->parent->getobj('eofilter:field_label');
                my $val = $pm->get;
              $val = "<undef>" unless defined $val;
                my $obj_name = $pm->{-labels}->{$val};
                my $f_cnt = 0;
                %field_names = ();
                @fkeys = ();
                my %fieldnames_tmp = %{Class::Tangram::attribute_types($obj_name)};
                foreach ( keys %fieldnames_tmp) {
                  $field_names{$f_cnt} = $_ if (($fieldnames_tmp{$_} eq 'string') || ($fieldnames_tmp{$_} eq 'real'));
                  push @fkeys, $f_cnt if (($fieldnames_tmp{$_} eq 'string') || ($fieldnames_tmp{$_} eq 'real'));
                  $f_cnt++;
                }
              $lbl->draw;
        },
    );    

    $eofilter_dialog->add(
          'eofilter:field_label', 'Label',
          -x => 1,
          -y => 3,
          -text => 'Object Field:',
    );
    my $field_list = $eofilter_dialog->add(
      'eofilter:field_list', 'Popupmenu',
      -x => 15,
      -y => 3,
      -values     => \@fkeys,
      -labels     => \%field_names,
      -width      => 25,
    );    

    $eofilter_dialog->add(
          'eofilter:value_label', 'Label',
          -x => 1,
          -y => 5,
          -text => 'Key Value:',
    );

    my $entry = $eofilter_dialog->add(
        'eofilter:value_entry', 'TextEntry',
        -x => 15,
        -y => 5,
        -singleline => 1,
        -maxlength => 50,
        -border => 1,
    );
  
    $eofilter_dialog->add(
      'eofilter:button', 'Buttonbox',
      -buttons => [
        {
          -label=> '< OK >',
                -onpress =>  sub {
                  my $bt = shift;
                  my $type_obj = $bt->parent->getobj('eofilter:type_list');
                  my $field_obj = $bt->parent->getobj('eofilter:field_list');
                  my $entry_obj = $bt->parent->getobj('eofilter:value_entry');
                  _selectObject($concret_names{$type_obj->get()}, $field_names{$field_obj->get()}, $entry_obj->get());
                $cui->delete("EditOfilter_dialog");
                $cui->draw();
                },
        },
        {
          -label=> '< CANCEL >',
                -onpress =>  \&close_win,
        }
       ],
      -buttonalignment => 'center',
      -x => 20,
      -y => -1,
    );
    $eofilter_dialog->focus();
    push(@windows, 'EditOfilter_dialog');  
}

#-------- Generic Select Objects by Filter
sub _selectObject {
  my %obj_filter;
  $obj_filter{type} = shift;
  $obj_filter{field} = shift;
  $obj_filter{value} = shift;
  
  if ($obj_filter{value} eq '*') {
    $obj_filter{value} = 'all';
    delete $obj_filter{field};
  }
 
  my $results = $bizProcess->getObjectsByFilter(\%obj_filter);
  my @results = @{$results};
  my $keys = $#results;
  if ($keys !=-1) {
    foreach (@results) {
      my $oid = $bizProcess->{storage}->id($_);
      my $object = $bizProcess->{storage}->getObject($oid);
      my $class_meta = _getClassInfo($object);
      $_->{label} = " " . $oid . "      " . $class_meta->{class} . "            " . $obj_filter{field} . "              " . $_->{$obj_filter{field}};
    }
    my $topic = "Object ID         Object Type          Searched Field:            Searched string";
    my $Tlist = _getObjectList( \@results,$topic);
  } else {
                $cui->error(-message => "There are no Objects with filter rules  Object Type: " . $obj_filter{type} . "  Field: " . $obj_filter{field} . " Value: " . $obj_filter{value});
  }
}

#-------- List Transaction Objects
sub listTransactions {
  my $selection = shift;
  my $select;
  if ($selection) { $select = { field => 'status', value => $selection,};}
  else { $select = ''; }
  
  my $results = $bizProcess->selectTransactions($select);
  my @results = @{$results};
  my $keys = $#results;
  if ($keys !=-1) {
    foreach (@results) {
      my $transid = $bizProcess->{storage}->id($_);
      $_->{label} = " " . $transid . "      " . ref( $_->{source}) . "            " . ref( $_->{target}) . "              " . $_->{amount};
    }
    my $topic = "TransactionID        Source              Destination                Amount";
    my $Tlist = _getObjectList( \@results,$topic);
  } else {
                $cui->error(-message => "There are no " . $selection . " Transactions!");
  }
}


#--------- Get Objects As List in New Window
sub _getObjectList {
  my $results = shift;
  my $topic = shift;
  my %labels;
  my @objectIds;
  my $winId = 0;

  my @results = @{$results};
  foreach (@results) {
      push(@objectIds, $bizProcess->{storage}->id($_));
      $labels{$bizProcess->{storage}->id($_)} =  $_->{label} ;
      $winId = $winId + int $bizProcess->{storage}->id($_);
  }

  my $listId = "ObjectList:" . $winId;
  my $list_win = $cui->getobj($listId);
  if ($list_win) {
    $list_win->focus;
    $status->text("List Window already open! Switched to it....");
    $cui->draw;
    return;
  }

    my $List_win = $cui->add(
      $listId,'Window',
      -padtop    => 1, 
      -padbottom    => 3, 
      -ipad         => 1,
        -border => 1,
        -title => $listId,
        -onfocus => sub{
            $focused_win = $listId;
            $status->text("Status: Focus to " . $listId);
        },
    );

    my $listlabel = $List_win->add(
        'listlabel:'.$#windows, 'Label',
        -label     => 'Tlists',
        -bold      => 1,
        -text => $topic,
    );

    $List_win->add(
        'listbox:'.$#windows, 'Listbox',
        -values    => \@objectIds,
        -labels    => \%labels,
        -border => 1,
        -padtop => 2,
        -padbottom => 2,
        -hscrollbar      => 1,
        -vscrollbar      => 1,
        -onchange =>  \&showObjectById,
    );

    $List_win->add(
      'list_button:'.$#windows, 'Buttonbox',
      -buttons => [
        {
          -label=> '<SELECT>',
                -onpress =>  \&showObjectById,
        },
        {
          -label=> '<CLOSE>',
                -onpress =>  \&close_win,
        },
      ],
      -width => 16,
      -buttonalignment => 'center',
      -y => -1,
    );

    $List_win->focus;
    push(@windows, $listId);
}

#----------- Show Object by ID
sub showObjectById {
  my $listbox = shift;
  my $objectId = $listbox->get;
  
  my $object_win = $cui->getobj("eObject:".$objectId);
  if ($object_win) {
    $object_win->focus;
    $status->text("Object already open! Switched to it....");
    $cui->draw;
  }
  elsif ($objectId) {
    my $eObj = _editObject( $objectId );
  }
  else {
                $cui->error(-message => "No Object selected! Use <ENTER> or <SPACEBAR> to select.");
        }
}

#---------- Edit Object
sub _editObject {
  my $objectId = shift;

  my $object_win = $cui->getobj("eObject:".$objectId);
  if ($object_win) {
    $object_win->focus;
    $status->text("Object already open! Switched to it....");
    return;
  }

  my $eObject_winid = "eObject:" . $objectId;
  my $object = $bizProcess->{storage}->getObject($objectId);
  my $class_meta = $bizProcess->_getClassInfo($object);
  
  my $entry;
  
  my  $eObject_win = $cui->add(
      $eObject_winid,'Window',
      -x => 2,
      -y => 2,
      -padbottom    => 2, 
        -border => 1,
        -vscrollbar      => 1,
        -hscrollbar      => 1,
        -title => $eObject_winid,
        -onfocus => sub{
            $focused_win = $eObject_winid;
            $status->text("Status: Focus to " . $eObject_winid);
        },
    );

   my $label = $eObject_win->add(
        "Olabel:" . $objectId, 'Label',
        -label     => 'Object',
        -bold      => 1,
        -text => "Edit Object: " . $class_meta->{class} . "          ID: " . $objectId,
        -border => 1,
        -centered => 1,
    );

    $label->draw;
  my $cnt = 1;
  foreach (keys %{$object} ) {
    if ($_ eq 'label') { delete $object->{$_}; next; }
    my $class_meta = $bizProcess->_getClassInfo($object->{$_});
    my $oy = $cnt * 3;
    my $lid = $cnt . $objectId;
    my $sublabel = $eObject_win->add(
        $lid, 'Label',
        -label     => 'Object',
        -bold      => 1,
        -text => $_,
        -y => $oy,
        -padleft => 1,
    );
    
    if ($bizProcess->{storage}->id($object->{$_})) {
      my $oid = $bizProcess->{storage}->id($object->{$_});
      my $button = $eObject_win->add(
        'buttons:'.$objectId.':'.$_, 'Buttonbox',
        -buttons => [{
            -label=> '< ' . $class_meta->{class} . ' >',
                -onpress =>  sub { _editObject($oid); },
        }],
        -x => 35,
        -y => $oy,
      );
      
    }
    elsif( ((ref($object->{$_}) eq 'ARRAY') || (ref($object->{$_}) eq 'HASH')) ) {
      my @keys;
      my $label_ref;
      my $suboid;

      if (ref($object->{$_}) eq 'HASH') {
        my $cnt = 0;
        my %tmp_hash;
        foreach (keys %{$object->{$_}}) {
          $suboid = $bizProcess->{storage}->id($_) if ($bizProcess->{storage}->id($_));
          $tmp_hash{$suboid} = $_;
          push @keys, $cnt;
          $cnt++;
        }
        $label_ref = \%tmp_hash;
      }
      elsif (ref($object->{$_}) eq 'ARRAY') {
        my $cnt = 0;
        my %htmp;
        my $tmp = $_;
        foreach (@{$object->{$_}}) {
          $suboid = $bizProcess->{storage}->id($_) if ($bizProcess->{storage}->id($_));
          $htmp{$suboid} = $cnt;
          push @keys, $cnt;
          $cnt++;
        }
        $label_ref = \%htmp;
      }
        if ($suboid) {
          my $id = $objectId . ":" . $_;
          my $button = $eObject_win->add(
            'list:'.$objectId.':'.$_, 'Popupmenu',
            -values => \@keys,
          -labels => $label_ref,
          -x => 35,
          -y => $oy,
          -onchange => sub {
              my $oha = shift;
              my $label = $oha->get();
              my $oid;
              foreach (keys %{$label_ref}) { $oid = $_ if($label_ref->{$_} eq $label); }
              print STDERR "suboid: " , $oid, "\n";
              _editObject($oid);
            },
         );
       }
       else {
         my $dump = Dumper($object->{$_});
         my $button = $eObject_win->add(
           'buttons:'.$objectId.':'.$_, 'Buttonbox',
            -buttons => [{
              -label=> '< DUMP >',
                -onpress =>  sub { 
                  my $dumpwin = newLogWin($objectId.':'.$_);
                  $dumpwin->text($dump);
                  $dumpwin->focus();
                    },
              }],
            -x => 35,
            -y => $oy,
         );
       }         
    }
    else {
      $entry->{$_} = $eObject_win->add(
        'Otextentry'.$_, 'TextEntry',
        -singleline => 1,
        -heigth => 1,
        -border => 1,
        -text => $object->{$_},
        -x => 35,
        -y => $oy-1,
      );
    }
    
   $cnt++;
   $sublabel->draw;
  }
      my $button = $eObject_win->add(
        'button:'.$objectId, 'Buttonbox',
        -buttons => [
          {
            -label=> '< Cancel/Back >',
                -onpress =>  \&close_win,
          },
          {
            -label=> '< Save >',
                -onpress => sub { close_win(); saveObject( $object, $entry ); },
          },
        ],
        -buttonalignment => 'center',
        -x => 35,
        -y => -2,
      );

 $eObject_win->focus;
 push(@windows, $eObject_winid);
}


#---------- Edit Hash / Array of Object
sub _editObjectHA {
  my $object = shift;
  my $objectId = shift;
  my $subentry = shift;

  print STDERR Dumper($subentry);

  my $oha_win_tmp = $cui->getobj("ohaWin:".$objectId);
  if ($oha_win_tmp) {
    $oha_win_tmp->focus;
    $status->text("Hash or Array of Object: " . $objectId . " already open! Switched to it....");
    return;
  }

  my $oha_winid = "ohaWin:" . $objectId;
  my $obj_real = $bizProcess->{storage}->getObject($objectId);
  my $class_meta = $bizProcess->_getClassInfo($obj_real);
  
  my $entry;
  
  my  $oha_win = $cui->add(
      $oha_winid,'Window',
      -x => 2,
      -y => 2,
      -padbottom    => 2, 
        -border => 1,
        -vscrollbar      => 1,
        -hscrollbar      => 1,
        -title => $oha_winid,
        -onfocus => sub{
            $focused_win = $oha_winid;
            $status->text("Status: Focus to " . $oha_winid);
        },
    );


   my $label = $oha_win->add(
        "oha_label:" . $objectId, 'Label',
        -label     => 'oha',
        -bold      => 1,
        -text => "Edit Object: " . $class_meta->{class} . "          ID: " . $objectId . "\n" . $subentry->{oentry} . ': ' . $subentry->{oha_entry},
        -border => 1,
        -centered => 1,
    );

    $label->draw;

  my $list = $object->{$subentry->{oentry}}->[$subentry->{oha_entry}];
  print STDERR Dumper($list);
  if ( ref($list)) {
    my $cnt = 1;
    foreach (keys %{$list} ) {
      my $oy = $cnt * 3;
      my $lid = $cnt . $objectId;
      my $sublabel = $oha_win->add(
          $lid, 'Label',
          -label     => 'Object',
          -bold      => 1,
          -text => $_,
          -y => $oy,
          -padleft => 1,
      );
      $entry->{$_} = $oha_win->add(
        'ohatextentry'.$_, 'TextEntry',
        -singleline => 1,
        -heigth => 1,
        -border => 1,
        -text => $object->{$_},
        -x => 35,
        -y => $oy-1,
      );
    
   $cnt++;
   $sublabel->draw;
  }
      my $button = $oha_win->add(
        'ohabutton:'.$objectId, 'Buttonbox',
        -buttons => [
          {
            -label=> '< Cancel/Back >',
                -onpress =>  \&close_win,
          },
          {
            -label=> '< Save >',
                -onpress => sub { close_win(); saveObject( $objectId, $entry ); },
          },
        ],
        -buttonalignment => 'center',
        -x => 35,
        -y => -2,
      );

   $oha_win->focus;
   push(@windows, $oha_winid);
  }
#  if ( ref($object->{$subentry->{entry}}) eq 'ARRAY') {
#  }
  else { 
                $cui->error(-message => "Error!");
  }

}


#---------- Save Object
sub saveObject {
    my $object = shift;
    my $entry = shift;
 
    foreach(keys %{$entry}) {
      $object->{$_} = $entry->{$_}->get();
    }
    $bizProcess->{storage}->update($object);
}

#---------- test callback
sub test {
#  no strict refs;
  my $object_name = 'MoneyTransaction';
  my $class = Class::Tangram::attribute_types($object_name);
  my $out = Dumper($class);
  my $title = "test";
  my $testwin = newLogWin($title);
  $testwin->text($out);
}


#---------- Backend Database Functions
sub retreat_backend {
  my @cmd = ( 'perl', 'db_setup.pl', '--dbkey=backend', '--action=retreat' );
  my $out = _start_ipc( \@cmd );
  my $title = join(' ', @cmd);
  my $retreatlog = newLogWin($title);
  $retreatlog->text($out);
}

sub deploy_backend {
  my @cmd = ( 'perl', 'db_setup.pl', '--dbkey=backend', '--action=deploy' );
  my $out = _start_ipc( \@cmd );
  my $title = join(' ', @cmd);
  my $deploylog = newLogWin($title);
  $deploylog->text($out);
}

sub feed_backend {
  my @cmd = ( 'perl', 'backend_feed.pl', );
  my $out = _start_ipc( \@cmd );
  my $title = join(' ', @cmd);
  my $feedlog = newLogWin($title);
  $feedlog->text($out);
}

sub reset_backend {
  retreat_backend();
  deploy_backend();
  feed_backend();
}


#-------- Run command
sub command_dialog {
    my $cmd_dialog = $cui->add(
      'Cmd_dialog','Window',
      -centered => 1,
      -width => 60, 
        -height => 10,
        -border => 1,
        -title => "Type command:",
        -onfocus => sub{
            $focused_win = 'Cmd_dialog';
            $status->text("Status: Focus to " . "Cmd_dialog");
        },
    );
    
    my $cmd_textentry = $cmd_dialog->add(
        'cmd_textentry', 'TextEntry',
        -singleline => 1,
        -maxlength => 50,
        -border => 1,
        -centered => 1,
    );
    my $cmd_button = $cmd_dialog->add(
      'cmd_button', 'Buttonbox',
      -buttons => [
        {
          -label=> '< RUN >',
                -onpress =>  sub { 
                _run_command($cmd_textentry->get());
                $cui->delete('Cmd_dialog');
                },
        },
        {
          -label=> '< CANCEL >',
                -onpress =>  \&close_win,
        }
       ],
      -buttonalignment => 'center',
      -x => 20,
      -y => -1,
    );

    $cmd_textentry->focus();
    push(@windows, 'Cmd_dialog');
}

sub _run_command {
  my $cmdstring = shift;
  
  my @cmd = split(' ', $cmdstring);  
  my $out = _start_ipc( \@cmd );
  if (!$out) { $cui->error("Unkown command!"); }
  my $id  = rand 3443; 
  my $ident = "Output:$id";
  my $tmpout = newLogWin($ident);
  my $outwin = $cui->getobj ( $ident);
  $outwin->focus();
  $tmpout->text($out);
  $cui->draw(); 
}


#-------- Gerneric Output Window
sub newLogWin {
  my $ident = shift;

  my $win = $cui->getobj($ident);
  if ($win) {
    $win->focus;
    $status->text("Window already open! Switched to it....");
    $cui->draw;
    return;
  }

  my $logwin = $cui->add(
      $ident,'Window',
      -x => 1**$#windows,
      -y => 1**$#windows, 
      -titlereverse => 0, 
      -padright    => 5-$#windows, 
      -padleft    => 0+$#windows, 
      -padbottom    => 3, 
      -ipad         => 1,
        -border => 1,
        -title => $ident,
        -onfocus => sub{
              $status->text("Status: Focus to " . $ident);
              $focused_win = $ident;
          },
    );

  my $txtid = "t_$ident";
  
  my $textwin = $logwin->add(
        $txtid, 'TextViewer',
        -showlines       => 0,
        -sbborder        => 0,
        -vscrollbar      => 1,
        -hscrollbar      => 1,
        -showhardreturns => 0,
        -wrapping        => 0, # wrapping slows down the editor :-(
        -text => '',
  );
  
  # Bring the focus to the editor widget.
#  $logwin{$ident}->focus;
  
  push(@windows, $ident);
  return $textwin; 
}


#---------- close windows
sub close_win {
  my $tid = 0;
  my $cnt=0;
  foreach (@windows) {
    if ($_ && $_ eq $focused_win) { $tid = $cnt; }
    $cnt++;
  }

        for(my $i=0;$i<100000000000;) {
          my $wid = $tid+$i;
          if (!$windows[$wid] || $windows[$wid] eq '') {
            $i++;
          }
          else {
            $status->text("Status:  window closed");
            switch_win();
            $cui->delete($windows[$wid]);
            delete $windows[$wid];
                $cui->layout;
                $cui->draw;
            last;
          }
        }
}

#-------- switch windows
sub switch_win {
  return if ($#windows==-1 || $#windows ==1);
  my $tmpid = 0;
  my $cnt=0;
  foreach (@windows) {
    if ($_ && $_ eq $focused_win) { $tmpid = $cnt; }
    $cnt++;
  }
  my $obj;
  if ($tmpid < $cnt-1) {
        for(my $i=1;$i<100000000000;) { 
          my $wid = $tmpid+$i;
          if (!$windows[$wid]) {
            $i++;
          }
          else {
            $obj = $cui->getobj($windows[$wid]);
            $focused_win = $windows[$wid];
            last;
          }
        }
  }
  else {
        for(my $i=0;$i<100000000000;) { 
          my $wid = 0+$i;
          if (!$windows[$wid]) {
            $i++;
          }
          else {
            $obj = $cui->getobj($windows[$wid]);
            $focused_win = $windows[$wid];
            last;
          }
        }
  }
  $obj->focus if ($obj);
}

# Create the screen for the editor
sub _screen_editor {
  my $editor_win = $cui->add(
        'Editor', 'Window',
      -padtop       => 1, 
      -padbottom    => 3, 
#       -border => 1,
        -onfocus => sub{
      $focused_win = 'Editor';
          $status->text("Status: Focus to " . 'Editor');
    },
  );
  return $editor_win;
}

sub start_editor {
  my $screen = _screen_editor();
  # We add the editor widget to this screen.
  my $editor = $screen->add(
        'txt_editor', 'TextEditor',
        -border          => 1,
        -padtop          => 0,  
        -padbottom       => 0,
        -showlines       => 0,
        -sbborder        => 0,
        -vscrollbar      => 1,
        -hscrollbar      => 1,
        -showhardreturns => 0,
        -wrapping        => 0, # wrapping slows down the editor :-(
        -text            => $text,
  );

  # There is no need for the editor widget to loose focus, so
  # the "loose-focus" binding is disabled here. This also enables the
  # use of the "TAB" key in the editor, which is nice to have.
#  $editor->clear_binding('loose-focus');
  
  # Bring the focus to the editor widget.
  $editor->focus;
  push(@windows, 'Editor');
}

#-------- Edito: Open File Dialog       
sub file_open_dialog()
{
        my $file = $cui->loadfilebrowser( 
                -file         => $currentfile,
        );

        if (defined $file) 
        {
                if (open F, "<$file") {
                    my $text = "";
                    while (<F>) { $text .= $_ }
                    close F;
                    $editor->text($text);
                    $editor->cursor_to_home;
                    $currentfile = $file;
                } else { 
                    $cui->error(-message => "Can't read file \"$file\":\n$!");
                }
        }
}

#------ Editor: Save File Dialog
sub file_save_dialog()
{

        my $file = $cui->savefilebrowser(
                -file         => $currentfile,
        );
        return unless defined $file;

        if (open F, ">$file") {
            print F $editor->text;
            if (close F) {
                $cui->dialog(-message => "File \"$file\"\nsuccessfully saved");
                $currentfile = $file;
            } else {
                $cui->error(-message => "Error on closing file \"$file\":\n$!");
            }
        } else {
            $cui->error(-message => "Can't write to $file:\n$!");
        }
}

#-------- About Dialog
sub about_dialog()
{
        $cui->dialog(
                -title => 'About gui',
                -message => "Program : Curses::UI GUI\n"
                          . "Author  : unkown\n"
                          . "\n"
        );
}
                
#--------- Exit Dialog
sub exit_dialog()
{
        my $return = $cui->dialog(
                        -title     => "Are you sure???", 
                        -buttons   => ['yes', 'no'],
                        -message => "Do you really want to quit?"
        );

        exit(0) if $return;
}

#-------- sub Start IPC with given CMD
sub _start_ipc {
  my $cmd = shift;
  my $in;my $out;my $err;
  my $t = timer ( 60 );
  my $h = start( $cmd, \$in, \$out, \$err, $t);
  pump $h; #until $err; #|| $t->is_expired;
#  $h->kill_kill;  #if ($t->is_expired || $err);
  $h->finish;
  return $err if($err);
  return $out if($out);
#  my $ipcrun = start
#     $cmd,
#        '<pipe', \*IN,
#        '>pipe', \*OUT,
#        '2>pipe', \*ERR,
#        $t  ;
 #    or die "could not open IPC::Run - handle: $?" ;
}

# ----------------------- Helper Functions ---------------------------
sub _getClassInfo {
  my $object = shift;
  
  # which class is it of?
  my $class = ref $object;
  
  # which classes is this class based on?
  my $bases = Class::Tangram::class_bases($class);
  
  return { class => $class, bases => $bases };
}


# ----------------------------------------------------------------------
# The main loop of the program
# ----------------------------------------------------------------------


$cui->set_binding(\&exit_dialog, "\cQ", "\cC");
#$cui->set_binding(\&switch_win, KEY_STAB);
$cui->set_binding(\&switch_win, "\cA");
$cui->set_binding(\&command_dialog, "\cR");
$cui->set_binding(\&start_editor, "\cE");
$cui->set_binding(\&close_win, "\cW");
$cui->set_binding(\&file_save_dialog, "\cS");
$cui->set_binding(\&file_open_dialog, "\cO");
$cui->set_binding(sub {shift()->getobj('menu')->focus}, "\cX", KEY_F(10));
$cui->set_binding(sub {
        my $cui = shift;
        $cui->layout;
        $cui->draw;
}, "\cL");


$cui->mainloop;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26