Perl 入門指南 - guidemo.pl




guidemo.pl 的程式原始碼如下

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
#!/usr/bin/perl -w
         
use Tk;
 
use strict;
use warnings;
 
use Encrypt;
 
my $encrypt = -1;
my $userinput = "";
my $result = "";
         
my $mw = MainWindow->new;
$mw->title("Encryptor");
 
my $input_label = $mw->Label(-text => "Input:");
$input_label->grid(-row => 0, -column => 0);       
my $input_field = $mw->Entry();
$input_field->grid(-row => 0, -column => 1, -columnspan => 6, -sticky => "ew");
my $output_label = $mw->Label(-text => "Output:");
$output_label->grid(-row => 1, -column => 0);       
my $output_field = $mw->Entry();
$output_field->grid(-row => 1, -column => 1, -columnspan => 6, -sticky => "ew");
 
my $new_button = $mw->Button(-text => "New", -command => \&new_button);
$new_button->grid(-row => 2, -column => 0);
my $load_button = $mw->Button(-text => "Load", -command => \&load_button);
$load_button->grid(-row => 2, -column => 1);
my $save_button = $mw->Button(-text => "Save", -command => \&save_button);
$save_button->grid(-row => 2, -column => 2);
my $encode_button = $mw->Button(-text => "Encode", -command => \&encode_button);
$encode_button->grid(-row => 2, -column => 3);
my $decode_button = $mw->Button(-text => "Decode", -command => \&decode_button);
$decode_button->grid(-row => 2, -column => 4);
my $clear_button = $mw->Button(-text => "Clear", -command => \&clear_button);
$clear_button->grid(-row => 2, -column => 5);
my $copy_button = $mw->Button(-text => "Copy", -command => \&copy_button);
$copy_button->grid(-row => 2, -column => 6);
 
my $display_message = "something happened";
my $display_label = $mw->Label(-text => $display_message, -textvariable => \$display_message);
$display_label->grid(-row => 3, -column => 0, -columnspan => 7);
 
sub new_button {
    $encrypt = new Encrypt;
    $display_message = "code: ".$encrypt->getCode();
}
 
sub load_button {
    my $data;
    if (-e './code.txt') {
        open(DATA, "<code.txt");
        read DATA, $data, 26;
        $encrypt = new Encrypt;
        $encrypt->setCode($data);
        close(DATA);
        $display_message = "code: ".$encrypt->getCode();
    }
    else {
        $display_message = "Load denied!!";
    }
}
 
sub save_button {
    if ($encrypt == -1) {
        $display_message = "No Encrypt object can save!!";
    }
    else {
        open(CODE, ">code.txt");
        print CODE $encrypt->getCode();
        close(CODE);
        $display_message = "The code is saved.";
    }
}
 
sub encode_button {
    $userinput = $input_field->get();
    if ($userinput eq "") {
        $display_message = "No input string!!";
    }
    else {
        if ($encrypt == -1) {
            $display_message = "No encrypt object!!";
        }
        else {
            $result = $encrypt->toEncode($userinput);
            $output_field->delete('0', 'end');
            $output_field->insert('end', $result);
            $display_message = "Encoding success!!";
        }
    }   
}
 
sub decode_button {
    $userinput = $input_field->get();
    if ($userinput eq "") {
        $display_message = "No input string!!";
    }
    else {
        if ($encrypt == -1) {
            $display_message = "No encrypt object!!";
        }
        else {
            $result = $encrypt->toDecode($userinput);
            $output_field->delete('0', 'end');
            $output_field->insert('end', $result);
            $display_message = "Decoding success!!";
        }
    }   
}
 
sub clear_button {
    $encrypt = -1;
    $userinput = "";
    $result = "";
    $input_field->delete('0', 'end');
    $output_field->delete('0', 'end');
    $display_message = "It's done.";
}
 
sub copy_button {
    if ($result eq "") {
        $display_message = "Copy denied!!";
    }
    else {
        $mw->clipboardClear;
        $mw->clipboardAppend($result);
        $display_message = "It is already copied to the clipboard.";
    }
} 
       
MainLoop;
 
# 《程式語言教學誌》的範例程式
# http://pydoing.blogspot.com/
# 檔名：guidemo.pl
# 功能：示範 Perl 程式
# 作者：張凱慶
# 時間：西元 2013 年 1 月


您可以繼續參考
範例程式碼


相關目錄
回 Perl 入門指南
回 Perl 教材
回首頁


參考資料
http://www.perl.org/
http://learn.perl.org/
http://perldoc.perl.org/index.html
http://www.tutorialspoint.com/perl/index.htm
http://perl-begin.org/
http://www.bin-co.com/perl/perl_tk_tutorial/
標籤： ,

沒有留言:

張貼留言

訂閱： 張貼留言 (Atom)