lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / UI.pm

package Lire::UI;

use strict;

use Curses;
use Curses::UI;
use Curses::UI::Common;
use File::Basename;
use Locale::TextDomain 'lire';
use Text::Wrap qw/ wrap /;

use Lire::Config;
use Lire::DlfStore;
use Lire::Utils qw/check_object_param /;
use Lire::Error qw/ an_error_occured /;
use Lire::Config::Build qw/ ac_info /;
use Lire::Config::ConfigFile;
use Lire::UI::Prefs;
use Lire::UI::Widget;
use Lire::UI::Utils qw/button_box_width/;

=pod

=head1 NAME

Lire::UI - Interface to a DLF store

=head1 SYNOPSIS

  use Lire::Config;
  use Lire::UI;
  use Lire::PluginManager;

  Lire::Config->init();

  Lire::PluginManager->register_default_plugins();
  my $ui = Lire::UI->new();
  $ui->curses_ui()->clear_on_exit( 1 );
  exit( $ui->mainloop() );

=head1 DESCRIPTION

The Lire::UI object creates a Curses::UI application.

=cut

sub new {
    my $class = $_[0];

    my $ui = new Curses::UI();
    my $self = bless { '_ui' => $ui }, $class;
    $ui->userdata( $self );

    $self->_create_menubar();
    $self->_create_quickstart_win();

    return $self;
}

=pod

=head2 curses_ui()

Returns the Curses::UI object used for the interface.

=cut
sub curses_ui {
    my $self = $_[0];

    return $self->{'_ui'};
}

=pod

=head2 edit_value_dialog( $value, [$title] )

Opens a modal dialog that can edit the Lire::Config::Value $value. The
dialog has an OK and Cancel button and contains one Lire::UI::Widget
appropriate for the $value type. The method returns true when the OK
button was selected, false otherwise.

=cut
sub edit_value_dialog {
    my ( $self, $value, $title ) = @_;

    check_object_param( $value, 'value', 'Lire::Config::Value' );
    $title ||= __x( 'Editing {component}', 'component' => $value->summary() );

    my $retvalue = 0;
    my $name = "edit_value_dialog_$value";
    my $dlg = $self->{'_ui'}->add( $name, 'Curses::UI::Window',
                                   '-title' => $title,
                                   '-border' => 1,
                                   '-padtop' => 2, '-pad' => 1,
                                   '-ipad' => 1 );
    $dlg->set_binding( sub { $dlg->loose_focus() }, CUI_ESCAPE );
    $dlg->add( 'widget', 'Lire::UI::Widget',
               '-releasefocus' => 1,
               'value' => $value,
               '-width' => $dlg->canvaswidth() - 1,
               '-height' => $dlg->canvasheight() - 2 );

    my $buttons = [ {'-label' => __( '< Cancel >' ),
                     '-onpress' => sub { $dlg->loose_focus() } },
                    {'-label' => __( '< OK >' ),
                     '-onpress' => sub { $retvalue = 1;
                                         $dlg->loose_focus() } } ];
    my $bb_width = button_box_width( $buttons );
    $dlg->add( 'buttons', 'Curses::UI::Buttonbox',
               '-buttons' => $buttons,
               '-x' => $dlg->canvaswidth() - $bb_width - 10,
               '-y' => $dlg->canvasheight() - 1,
               '-width' => $bb_width, '-height' => 1 );

    $dlg->modalfocus();
    $self->{'_ui'}->delete( $name );
    $self->{'_ui'}->draw( 1 );

    return $retvalue;
}

sub _create_quickstart_win {
    my $self = $_[0];

    my $win = $self->{'_ui'}->add( 'quickstart_win', 'Window',
                                   '-y' => 1, '-border' => 1 );
    my $text = $win->add( 'text_viewer', 'TextViewer',
                          '-vscrollbar' => 1,
                          '-text' => __( <<'_EOD' ) );

    Welcome to Lire, the versatile log-analyser!

  This is a quick graphical user-interface for configuring Lire and for
  managing DLF stores (the directories where your reports and logs data is
  stored and handled).

  To access the menubar, press <F10> or <Ctrl-x>. To wander between
  the different widgets contained in a window or a dialog, use the
  <TAB> key. When done, press <F10> or <Ctrl-x>, choose the Lire
  widget and choose quit. Your changes will be savely stored.

  The first time you use Lire, you are encouraged to have a look at and to
  modify the global Lire preferences to ensure they suit your needs.
  Go to the "Lire->Preferences..." menu to do so.

  If you want to generate periodical reports, you should create a
  new DLF store and then add it import jobs and report jobs.
  Import jobs are meant to parse and convert specified logfiles into the
  store database for further processing, while report jobs process the
  gathered data to produce and format reports.  Be sure you have some
  lr_cron calls in your personal crontab.

  If you think you could gain significant storage room after a while,
  you can also clear old records since Lire will still be able to produce
  periodical reports by merging previous daily reports.
_EOD

    $win->focus();

    return;
}

sub _create_menubar {
    my $self = $_[0];

    my $menu = [ { '-label' => 'Lire',
                   '-submenu' => [ { '-label' => __( 'About Lire...' ),
                                     '-value' => \&_lire_about_cb },
                                   { '-label' => __( 'Preferences...' ),
                                     '-value' => \&_lire_prefs_cb },
                                   { '-label' => __( 'Quit' ),
                                     '-value' => \&_lire_quit_cb }
                                 ] },
                 { '-label' => 'Store',
                   '-submenu' => [ { '-label' => __( 'New...' ),
                                     '-value' => \&_store_new_cb },
                                   { '-label' => __( 'Open...' ),
                                     '-value' => \&_store_open_cb }
                                 ] },
               ];

    my $menubar = $self->{'_ui'}->add( 'menubar', 'Menubar',
                                       '-menu' => $menu );
    $self->{'_ui'}->set_binding( \&_focus_menubar_cb, KEY_F(10), "\cx" );

    return;
}

sub _update_store_menu {
    my ( $self, $active ) = @_;

    my $submenu = ( $active
                    ? [ { '-label' => __( 'Close' ),
                          '-value' => \&_store_close_cb } ]
                    : [ { '-label' => __( 'New...' ),
                          '-value' => \&_store_new_cb },
                        { '-label' => __( 'Open...' ),
                          '-value' => \&_store_open_cb } ] );
    my $menubar = $self->{'_ui'}->getobj( 'menubar' );
    $menubar->{'-menu'}[1]{'-submenu'} = $submenu;

    return;
}

sub mainloop {
    my $self = $_[0];

    local $SIG{'__WARN__'} = sub {
        local $Text::Wrap::columns = 60;
        my $msg = wrap( '', '', shift );
        $self->{'_ui'}->status( $msg );
        sleep 2;
    };
    eval { $self->{'_ui'}->mainloop(); };
    my $exit_code = $@;

    die "Code reached unexpectedly... Beware, maybe your computer is haunted."
      unless $exit_code;

    my $store_win = $self->{'_ui'}->getobj( 'store_win' );
    $store_win->store()->close() if defined $store_win;

    return 0
      if ( $exit_code eq "Quit\n" );

    $self->{'_ui'}->error( an_error_occured( $exit_code ) );

    return 1;
}

sub cleanup {
    my $self = $_[0];

    $self->{'_ui'}{'-userdata'} = undef;
    $self->{'_ui'} = undef;

    return;
}

sub _get_config_file {
    my $self = $_[0];

    my $cfg_file = "$ENV{'HOME'}/.lire/config.xml";
    my $found = grep { $_ eq $cfg_file } Lire::Config->config_files();
    unless ( $found ) {
        my $file = new Lire::Config::ConfigFile( 'spec' => Lire::Config->config_spec(),
                                                 'filename' => $cfg_file );
        my $dirname = dirname( $cfg_file );
        mkdir $dirname, 0700
          unless ( -d $dirname );
        $file->save();
        Lire::Config->add_config_file( $cfg_file );
    }

    return Lire::Config->get_config_file( $cfg_file );
}

# callback functions

sub _lire_about_cb {
    my $widget = $_[0];

    my $ui = $widget->root();
    $ui->dialog('-title' => __x( 'About Lire {version}',
                                 'version' => ac_info( 'VERSION' ) ),
                '-message' => __x( <<'_EOF','version' => ac_info( 'VERSION' ) ) );
        Lire {version} - the versatile log-analyser

              http://www.logreport.org/

       Lire is developed and maintained by the
  LogReport Development Team <logreport@logreport.org>

Copyright (c) 2000-2004  Stichting Logreport Foundation
Some parts of Lire are also copyrighted by third-parties.
Please consult the AUTHORS file in the Lire distribution
for the complete list.
_EOF

    return;
}

sub _lire_prefs_cb {
    my $widget = $_[0];

    my $ui = $widget->root();
    my $prefs = new Lire::UI::Prefs( $ui, $ui->userdata()->_get_config_file());
    $prefs->show();

    return;
}

sub _lire_quit_cb {
    die "Quit\n";
}

sub _store_new_cb {
    my $widget = $_[0];

    my $ui = $widget->root();
    my $store_path =
      $ui->filebrowser( '-title' => __( 'Create a New Store...' ),
                        '-editfilename' => 1 );
    return unless defined $store_path;

    my $store = eval { Lire::DlfStore->open( $store_path, 1 ) };
    if ( $@ ) {
        $ui->error( __x( "Error creating store:\n    {error}",
                         'error' => $@ ) );
        return;
    }
    $ui->userdata()->_open_store_window( $store );

    return;
}

sub _open_store_window {
    my ( $self, $store ) = @_;

    my $store_win = $self->{'_ui'}->add( 'store_win', 'Lire::UI::StoreWindow',
                                         'store' => $store,
                                         '-y' => 1 );
    $self->_update_store_menu( 1 );
    $store_win->focus();

    return;
}

sub _store_open_cb {
    my $widget = $_[0];

    my $ui = $widget->root();
    my $store_path = $ui->dirbrowser( '-title' => __( 'Choose a Store...' ) );
    return unless defined $store_path;

    my $store = eval { Lire::DlfStore->open( $store_path ) };
    if ( $@ ) {
        $ui->error( __x( "Error opening store:\n    {error}",
                         'error' => $@ ) );
        return;
    }
    $ui->userdata()->_open_store_window( $store );

    return;
}

sub _store_close_cb {
    my $widget = $_[0];

    $widget->root()->getobj( 'store_win' )->store()->close();
    $widget->root()->delete( 'store_win' );
    $widget->root()->userdata()->_update_store_menu(0);

    return;
}

sub _focus_menubar_cb {
    my $widget = $_[0];

    $widget->root()->focus( 'menubar' );

    return;
}

# keep perl happy
1;

__END__

=pod

=head1 SEE ALSO

lire(1), Curses::UI(3pm)

=head1 VERSION

$Id: UI.pm,v 1.25 2006/07/23 13:16:30 vanbaal Exp $

=head1 AUTHORS

  Francis J. Lacoste <flacoste@logreport.org>
  Wolfgang Sourdeau <wolfgang@logreport.org>

=head1 COPYRIGHT

Copyright (C) 2004 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program 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 General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html.

=cut