path: root/perl-install/interactive.pm

package interactive;

use diagnostics;
use strict;

#-######################################################################################
#- misc imports
#-######################################################################################
use common;
use do_pkgs;

=head1 NAME

interactive - a GUI layer with multiple backend (text console, Gtk+ GUI, web)

=head1 SYNOPSYS

B<interactive> enables to write GUIes that will work everywhere:

=head1 Functions

=over 4

=item * text console

implemented by L<interactive::stdio> & L<interactive::curses>

=item * web browser

implemented by L<interactive::http>

=item * GUI

implemented by L<interactive::gtk>

=back

Interactive inherits from L<do_pkgs> and thus $in->do_pkgs will return
an usable C<do_pkgs> object suitable for installing packages.

=head1 Minimal example using interactive

 use lib qw(/usr/lib/libDrakX);
 use interactive;
 my $in = interactive->vnew;
 $in->ask_okcancel('title', 'question');
 $in->exit;

=head1 Backends

heritate from this class and you'll get all made interactivity for same steps.
for this you need to provide

C<ask_from_listW(o, title, messages, arrayref, default)> which returns one string of arrayref

where:

=over 4

=item * B<o> is the object

=item * B<title> is a string

=item * B<messages> is an refarray of strings

=item * B<default> is an optional string (default is in arrayref)

=item * B<arrayref> is an arrayref of strings

=item * B<arrayref>2 contains booleans telling the default state,

=back

=head1 Functions

=over

=cut

#-######################################################################################
#- OO Stuff
#-######################################################################################
our @ISA = qw(do_pkgs);

sub new($) {
    my ($type) = @_;

    bless {}, ref($type) || $type;
}

sub vnew {
    my ($_type, $o_su, $o_icon) = @_;
    my $su = $o_su eq "su";
    if ($ENV{INTERACTIVE_HTTP}) {
	require interactive::http;
	return interactive::http->new;
    }
    require c;
    if ($su) {
	$ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}";
	$su = '' if $::testing || $ENV{TESTING};
    }
    require_root_capability() if $su;
    if (check_for_xserver()) {
	eval { require interactive::gtk };
	if (!$@) {
	    my $o = interactive::gtk->new;
	    if ($o_icon && $o_icon ne 'default' && !$::isWizard) { $o->{icon} = $o_icon } else { undef $o->{icon} }
	    return $o;
	} elsif ($::testing) {
	    die;
	}
    }

    require interactive::curses;
    interactive::curses->new;
}

sub ok { N_("Ok") }
sub cancel { N_("Cancel") }

sub markup_parse {
    my ($s) = @_;
    my @l;
    my @attrs;

    while ($s) {
	if ($s =~ s!^<(\w+)(\s+[^>]*?)?>!!s) {
	    push @attrs, [ $1, $2 ];
	} elsif ($s =~ s!^</(\w+)>!!) {
	    my $previous = pop @attrs;
	    $previous->[0] eq $1 or return;
	} elsif ($s =~ s!^(&(amp|lt|gt);)!!) {
	    push @l, [ $1, @attrs ];
	} elsif ($s =~ s!^([^<>&]+)!!s) {
	    push @l, [ $1, @attrs ];
	} else {
	    return;
	}
    }