VPF::PERL + TK. - Форум программистов

dixoNICH

Дата 7.5.2011, 18:58 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 222
Регистрация: 20.3.2011

Репутация: нет
Всего: нет

в общем хочу в свою программку передать то, что мне ввели из графического интерфейса.
вот так : т.е я в pop43 передаю $login и $password. но, почему то когда я запускаю файлик с tk, то сначала запускается сам pop43, а потом уже выполняется Tk.

Код


INIT {
use Tk;
use Tk::DialogBox;
use Encode;
use pop43 qw(PROCESSOR);
    $\=$/;
    my $help=decode("cp1251","ПОМОГАЮ ЁПТ");
    my $mw = MainWindow->new(-background => 'red');
    $mw->geometry("400x200");
    $mw->title("POP3-CLIENT");
        my $main_menu = $mw->Menu();
   $mw->configure(-menu => $main_menu);
my $file_menu = $main_menu->cascade(-label=>decode("cp1251","Меню"), -underline => 0, -tearoff=>0);
   $file_menu->command(-label=>decode("cp1251","Выход"), -underline=>0, -command=>sub{exit});
   $file_menu->command(-label=>decode("cp1251","Помощь"), -underline=>0, -command=>\&help);
   $mw->Label(-text => decode("cp1251","Логин?"))->pack(-side => "left");
   $log = $mw->Entry(-background => 'black', -foreground => 'white')->pack(-side => "right");
   $mw->Label(-text => decode("cp1251","Пароль?"))->pack(-side => "left");
   $pass = $mw->Entry(-background => 'black', -foreground => 'white')->pack(-side => "right");
   my $thebutton = $mw->Button( 
    -text => decode('cp1251',"Далее"),
    -width => 10,
    -relief => 'groove',
    -command => \&copy,)->pack(-side => "bottom");
   sub help {
     my $helpYOU = $mw->Toplevel;
        $helpYOU -> geometry('400x400');
        $helpYOU->title(decode("cp1251","Помощь"));
        $helpYOU->Label(-text => "$help", 
                        -font => "Times 10", 
                        -justify => 'left')->
                         pack(-side => "top") -> place();
    }
    sub copy {
        $login = $log->get();
        $password = $pass->get();
        print $login;
        print $password;
    }
    
MainLoop();
}

FreeGanzter

Дата 7.5.2011, 19:06 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 23
Регистрация: 4.5.2011

Репутация: нет
Всего: нет

немного разделом ошиблись лучшеб тут http://forum.vingrad.ru/forum/forum-596.html создали там GUI обсуждают

Это сообщение отредактировал(а) FreeGanzter - 7.5.2011, 19:07

dixoNICH

Дата 7.5.2011, 19:36 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 222
Регистрация: 20.3.2011

Репутация: нет
Всего: нет

думаю, что не критично smile

dixoNICH

Дата 7.5.2011, 20:05 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 222
Регистрация: 20.3.2011

Репутация: нет
Всего: нет

разобрасля, почему запускался сначала скрипт
но так и не понял, как из тк передать в скрипт переменную.

shamber

Дата 8.5.2011, 16:53 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: нет
Всего: 18

Я в расстроенных чувствах. У меня ваш код работает. Что я делаю не так?

Это сообщение отредактировал(а) shamber - 8.5.2011, 17:13

dixoNICH

Дата 8.5.2011, 17:23 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 222
Регистрация: 20.3.2011

Репутация: нет
Всего: нет

не, всё работает, но возник другой вопрос

Код


    sub copy {
        $login = $log->get();
        $password = $pass->get();
        $host = $hosts->get();
    }
     

my $connecting = $mw->Button( 
    -text => decode('cp1251',"Присоединиться"),
    -width => 20,
    -relief => 'groove',
    -command => \&copy, 
    -command => \&CONNECT($host) )->pack(-side => "top");

по-моей задумке должно работать так : запускаю программу, ввожу хост, тыкаю присоединиться, и он коннектится.
на деле запускаю программу и получаю :Can't connect to :, Invalid argument

Код


sub CONNECT($) {
        @_=($host);
        $socket =    IO::Socket::INET->new (
                    PeerAddr => $host,
                    PeerPort => 110,
                    Proto => "tcp",
                    Type => SOCK_STREAM)
                    or die "Can't connect to $host:$port, $!\n";
        }

shamber

Дата 8.5.2011, 17:31 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: нет
Всего: 18

Код


-command => \&CONNECT($host)

выбросить
добавить

Код


sub copy {
        $login = $log->get();
        $password = $pass->get();
        $host = $hosts->get();
        CONNECT($host);
}

Добавлено через 7 минут и 12 секунд
а еще неплохо проверку от дурака добавить, чтобы переменные небыли пустыми

Это сообщение отредактировал(а) shamber - 8.5.2011, 17:35

dixoNICH

Дата 9.5.2011, 09:31 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 222
Регистрация: 20.3.2011

Репутация: нет
Всего: нет

если они будут пустыми, то тк выдаст такую ошибку
Tk callback for .button
Tk::__ANON__ at C:/Perl/site/lib/Tk.pm line 250
Tk::Button::butUp at C:/Perl/site/lib/Tk/Button.pm line 175
<ButtonRelease-1>
(command bound to event)

и не откроет следующее окно smile

dixoNICH

Дата 9.5.2011, 10:48 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 222
Регистрация: 20.3.2011

Репутация: нет
Всего: нет

ещё одна проблема : есть таблица, надо её заполнить. данные для заполнения в функции :
как мне это осущетвить?

Код


sub LISTandRETR {
    print $socket "LIST\n";
    my $invitation=<$socket>;
    $invitation=~/(\d+)\D+(\d+)/; # выделяем кол-во сообщений и их объём
    my $qt=$1; # колличество сообщений
    my $s=$2;  # объём почтового ящика
    my @list;
    while(1){
        my $str = <$socket>;
        push @list,$str;
        last unless $str=~/(\d+)/;
    }
    my $i=0;
    while($i<$qt) {
        $invitation=$list[$i];
        $i++;
        $invitation=~m/(\d+)\s(\d+)/; # для вывода номера и размера письм
        my $num = $1;
        my $size = $2;
        print F"Number : $num\n";
        print F"Octets : $size\n";
        my $let=$1;
#######################################################################
        print $socket "RETR $num\n";                
        my $str;
        my $buf;
        vec(my $win, fileno($socket), 1) = 1;
        my $timeout = 10;
        while(1){
            my $p = select($win, undef, undef, $timeout);
            if($p>0){
                sysread($socket,$str,1024);
            }else{
             print "Timeout\n";
            }
            $buf .=$str;
            last if $str=~/\n?\.\r\n$/; #выходим когда получили точку
        }   
        #print $buf;
            if($buf=~/Subject:\s\=\?KOI8\-R\?B\?(.*)\?\=/){
                my $k=$1;
                my $m=decode_base64($k);
                Encode::from_to($m, "KOI8-R", "cp1251");
                print F "Subject: $m\n";
            }
            elsif($buf=~/Subject:\s(\w+)/) {
                print F "Subject: $1\n";
            }
            if($buf=~/Content-Type:\smiltipart\/mixed;\sboundary\=(.*)[\r\n]{4}(.+)/sg){
                my $message=$1;
                print $message;
                }
            
            if($buf=~m/Date:\s(.+)/g){
                print F "Date : $1\n";
            }
            if($buf=~/From:\s\=\?KOI8\-R\?B\?(.*)\?\=(.+)/i){
                $a=$1;
                $s=decode_base64($a);
                Encode::from_to($s, "KOI8-R", "cp1251");
                print F "From : $s $2\n";
            }
            elsif($buf=~/From:\s(.+(\<?)+.*(\>?)+)/i){
                print F "From : $1\n";
            }
            if($buf=~/Content-Type:\stext\/plain;\scharset=KOI8-R[\r\n]{2}Content-Transfer-Encoding:\sbase64[\r\n]{4}([\w\r\n\=\+\/]+)/gs) {
                my $k=$1;
                my $h=decode_base64($k);
                Encode::from_to($h, "KOI8-R", "cp1251");
                print F "Message :\n $h \n";
            }
            elsif($buf=~/Content-Type:\stext\/html;\scharset=KOI8-R[\r\n]{2}Content-Transfer-Encoding:\sbase64[\r\n]{4}([\w\r\n\=\+\/]+)[\r\n]{4}/gs) {
                my $k=$1;
                my $h=decode_base64($k);
                Encode::from_to($h, "KOI8-R", "cp1251");
                print F "Message :\n $h \n";
            }
            elsif($buf=~/Content-Type:\stext\/plain;\scharset=KOI8-R[\r\n]{4}(.+)[\r\n]{4}\-/){
                my $k=$1;
                #my $h=decode_base64($k);
                Encode::from_to($k, "KOI8-R", "cp1251");
                print F "Message :\n $k \n";
            }
            print F"<--------------------------->\n";
        while($buf=~/Content-Disposition:\sattachment;\s(\n)?(\s+)?filename="(.*)"/g){ # filename, baby
            my $filename=$3;
            open S, ">:raw", $filename;
            if($buf=~/X-Attachment-Id:\s\w+[\r\n]{4}([\w\r\n\=\+\/]+)/sg){
                my $file=$1;
                #print $file;
                $file=decode_base64($file);
                print S "$file";
                close S;
            }
        }
    }
}

Код


sub retr {
    my $wow = $mw->Toplevel;
    $wow->geometry("500x500");
    $wow->title(decode("cp1251",""));
    $wow -> resizable(0,0);
    my $mf = $wow->Button( 
        -text => decode('cp1251',"Удалить"),
        -width => 20,
        -relief => 'groove',
        -command => \&oh)->pack(-side => "top");
        my $scroll_text = $wow->Scrollbar();
        my $main_text = $wow->Text(-yscrollcommand => ['set', $scroll_text], -foreground => 'red');
        my $table_frame = $wow->Frame()->pack();
        my $table = $table_frame->Table(-columns => 12,
                        -rows => 4,
                                                                          -fixedrows => 1,
                        -scrollbars => 'oe',
                        -relief => 'raised');
        my $tmp_label = $table->Label(-text => decode("cp1251","Номер"), -width => 8, -relief =>'raised');
        $table->put(0, 1, $tmp_label);
        $tmp_label = $table->Label(-text => decode("cp1251","От кого"), -width => 8, -relief =>'raised');
             $table->put(0, 2, $tmp_label);
        $tmp_label = $table->Label(-text => decode("cp1251","Заголовок"), -width => 10, -relief =>'raised');
            $table->put(0, 3, $tmp_label);
        $tmp_label = $table->Label(-text => decode("cp1251","Дата"), -width => 8, -relief =>'raised');
              $table->put(0, 4, $tmp_label);
        }

dixoNICH

Дата 10.5.2011, 14:52 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 222
Регистрация: 20.3.2011

Репутация: нет
Всего: нет

помогите, пожалуйста, с примерной структурой функции, которую я должен описать smile

что я должен в неё передать, кроме как кол-ва сообщений

shamber

Дата 10.5.2011, 16:12 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: нет
Всего: 18

Вы щас о чем?

Добавлено через 39 секунд
может ссылку на массив сообщений

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: GUI \| Следующая тема »