view release on metacpan or  search on metacpan

lib/Text/Editor/Easy/Comm.pm  view on Meta::CPAN

                    'graphic_kill',
                    'repeat_instance_method',
                    'growing_check',
                    'set_at_end',
                    'unset_at_end',
                    #'zone',
                    'make_visible',
                    'set_replace',
                    'set_insert',
                    'insert_mode',
                    'background',
                    'set_background',
                    'set_highlight',
                    'visual_slurp',

                    # Event management
                    'key',
                    'clic',
                    'motion',
                    'resize',
                    'drag',
                    'wheel',
                    'double_clic',
                    'right_clic',
                    'execute_sequence',
                ],
            }
        );
        # Intégrer la possibilité de mettre un hachage dans "create_new_server" (quand 'sub' ne 'method')
        
        ############################################
        #
        # Bug à voir => méthodes non reportées sur les instances suivantes... => renommage des méthodes
        #
        ############################################
        #$editor->ask_thread(
        #    'add_thread_method',
        #    0,
        #    {
        #        'package' => 'Text::Editor::Easy::Abstract',
        #        'method' => {
        #            'insert_mode' => 'editor_insert_mode',
        #            'set_insert' => 'editor_set_insert',
        #            'set_replace' => 'editor_set_replace',
        #            'make_visible' => 'editor_make_visible',
        #        },
        #        'class' => 'Text::Editor::Easy',
        #    }
        #);

        Text::Editor::Easy->ask_thread(
            'add_thread_method',
            0,
            {
                'package' => 'Text::Editor::Easy::Abstract',
                'method'  => [ 
                        'reference_zone_events',
                        'exit', 
                        'abstract_join', 
                        'manage_event', 
                        'clipboard_set', 
                        'clipboard_get', 
                        'on_top_ref_editor', 
                        'on_editor_destroy', 
                        'repeat',
                        'repeat_class_method',
                        'window_set',
                        'window_get',
                        'graphic_zone_update',
                    ]
            }
        );
        Text::Editor::Easy->ask_thread(
            'add_thread_method',
            0,
            {
                'package' => 'Text::Editor::Easy::Abstract',
                'method'  => 'bind_key',
                'sub'      => 'bind_key_global',
            }
        );
        }
        # Permet de renvoyer 0 si pas de création (suite à problème)
        #return Text::Editor::Easy->ask_thread(
        #    'Text::Editor::Easy::Abstract::abstract_number',
        #    0,
        #);
        return 1;
    }
    else {
        #print "Appel de add_thread_object par le thread ", threads->tid, " pour l'instance $ref\n";
        return $editor->ask_thread(
            'add_thread_object',
            0,
            {
                'new' =>
                  [ 'Text::Editor::Easy::Comm::new_editor', $ref, $hash_ref ]
            }
        );
    }
}

my %editor;

sub set_ref {
    my ( $self, $ref ) = @_;

    return if ( !defined $ref );
    $com_unique{ refaddr $self } = $ref;
    
    print DBG "Dans set_ref, on fixe la ref $ref pour l'éditeur $self|", refaddr $self, "\n";
    print DBG "...tid = ", threads->tid, "\n";

    if ( ref $self ne 'Text::Editor::Easy::Async' ) {
        #print "Danger, Async référencé !\n";
        $editor{ threads->tid . '_' . $ref } = $self;        
    }
}

sub id {
    my ($self) = @_;

lib/Text/Editor/Easy/Comm.pm  view on Meta::CPAN

# Attention, le code retour devra être analysé en cas de problème : attente sur la queue cliente
# Pour l'instant, cela serait bloquant puisque thread_generator ne renvoie rien
# my $response = $queue_by_tid{threads->tid}->dequeue;
# return if ( ! defined $response );

    print DBG "Create_new_server_thread : Je renvoie $tid\n";
    if ( my $init_sub_ref = $options_ref->{'init'} ) {
        # There is an "init sub" associated with the thread creation : we execute it
        my ( $what, @param ) = @$init_sub_ref;
        Text::Editor::Easy::Async->ask_thread( $what, $tid, @param );
    }

    print DBG "Fin de create_new_server $tid\n";
    return $tid;
}

sub comm_eval {
    my ( $self, $program ) = @_;

    no warnings;    # Make visible "global lexical variables" in eval
    %get_tid_from_class_method;
    %get_tid_from_instance_method;
    %get_tid_from_thread_name;
    use warnings;

    my @return;
    my $return;
    if (wantarray) {
        @return = eval $program;
    }
    else {
        $return = eval $program;
    }
    if ($@) {
        print $@, "\n";
        return;
    }
    if (wantarray) {
        return @return;
    }
    else {
        return $return;
    }
}

sub have_task_done {

# Called from an interruptible long task
# the (long) interruptible task has to call explicitly "have_task_done" from time to time
#  ==> there is no pre-emption (use another thread or another process for that)
# Generally, long interruptible task will be called asynchronously (but not mandatory :
# blocking the calling thread with a synchronous call does not prevent other threads
# from making calls to the executing thread)

# If a long interruptible task launch another long interruptible task, the first
# task will recover CPU only when the 2nd launched task is over
    my $self_server = $thread_knowledge{'self_server'};
    my ( $method, $call_id, $reference, @param ) = get_task_to_do;

    if ( $method eq 'clipboard_set' ) {
        print "HAVE_TASK_DONE : Appel clipboard_set, @param\n";
    }
    execute_task( 'async', $self_server, $method, $call_id, $reference,
        @param );
}

sub execute_this_task {
    my ( $method, $call_id, $reference, @param ) = @_;
    my $self_server = $thread_knowledge{'self_server'};
    execute_task( 'async', $self_server, $method, $call_id, $reference,
        @param );
}

sub get_tid {
    return threads->tid;
}

sub get_tid_from_name_and_instance {
    my ( $id, $name ) = @_;
        
    if ( ! ref $id ) {
        # Appel d'une méthode de classe
        $id = '';
    }
    else {
        $id = $com_unique{ refaddr $id };

        if ( !defined $id ) {
            print STDERR "get_tid_from_name_and_instance : no reference found for object $id\n";
            return;
        }
    }

    my $hash_ref = $get_tid_from_thread_name{$name};
    my $server_tid = $hash_ref->{$id};
    if ( defined $server_tid ) {
        #print "Dans get_tid... 1 : renvoie server_tid = $server_tid\n";
        return $server_tid;
    }
    if ( defined $id ) {
        $server_tid = $hash_ref->{''};
    }
    #print "Dans get_tid... 2 : renvoie server_tid = $server_tid\n";
    return $server_tid;
}

sub use_module {
    my ( $self_server, $reference, $module ) = @_;
    
    eval "use $module";
    if ( $@ ) {
        # Lire les lignes et ajouter une origine supplémentaire (les lignes du module responsable du message)
        print STDERR "Wrong code for module $module :\n$@\n";
    }
}

sub model_method {
    my ( $self, @param ) = @_;
    
    print DBG "Dans model_method, tid = ", threads->tid, "\n";
    return @param;