Perl TK小程序

hawklei

初学TK,写了个模拟彩票生成的小程序share下,呵呵

#!/usr/bin/perl -w
#simlulation lottery generator program,only for  TK study
#2005-1-15
use Tk;
use diagnostics;
use Net::SMTP;   #for addition function
use Date::Manip;
#use strict;
###################create frame ############
my $main=new MainWindow;
$main->;maxsize(qw/380 440/);
$main->;minsize(qw/380 440/);
$main->;geometry("1024x768+100+50";
$main->;title("Lottery program";
$main->;configure(-background=>;"#CCCCCC";
my $frame_title=$main->;Frame(
                        -relief=>;'flat',
                        -borderwidth=>;'1',
                        -height=>;'55'
                        )->;pack(-side=>;'top',-fill=>;'both');
my $frame_submit=$main->;Frame(
                        -relief=>;'flat',
                        -height=>;'40',
                        -background=>;'#C8CCC8'
                        )->;pack(-side=>;'top',-fill=>;'both');
$frame_submit_sub=$frame_submit->;Frame()->;pack(
-side=>;'bottom',
-fill=>;'both');
$frame_mail=$frame_submit_sub->;Frame(
-background=>;'#C8CCC8')->;pack(
-side=>;'top',
-fill=>;'both');
my $frame_body=$main->;Frame()->;pack(-side=>;'top',-fill=>;'both');
######
my $frame_bottom=$main->;Frame(
                        -relief=>;'sunken',
                        -borderwidth=>;'1',
                        -height=>;'14',
                        )->;pack(-side=>;'bottom',-fill=>;'both');

my $frame_geninfo=$main->;Frame(
-relief=>;'flat',
-borderwidth=>;'1',
-background=>;'#C8CCC8',
-height=>;'160'
)->;pack(
-side=>;'bottom',
-fill=>;'both');
$frame_geninfo->;packPropagate(0);
$frame_count=$frame_geninfo->;Frame()->;pack(
-side=>;'top',
-fill=>;'both');
$frame_date=$frame_geninfo->;Frame()->;pack(
-side=>;'top',
-fill=>;'both');
$frame_pub=$frame_geninfo->;Frame()->;pack(
-side=>;'top',
-fill=>;'both');
$frame_space=$frame_geninfo->;Frame(
-relief=>;'raised',
-height=>;10)->;pack(
-side=>;'top',
-fill=>;'both');
$frame_space->;packPropagate(0);
###########################create other widget in frame##############
$photo="/mystuff/perl/tk/pl/tc.gif";
if(-e $photo) {
$logo=$frame_title->hoto(-file=>;$photo);
$frame_title->;Label(-image=>;$logo)
->;pack(-side=>;'left',-expand=>;0,-anchor=>;"e";
} else {
$frame_title->;Label(-text=>;"CHINA SPORT LOTTERY <7 IN 36>;",
-anchor=>;'center')->;pack(
-ipady=>;15,
-fill=>;'both');
}
$frame_submit->;Label(-text=>;"     Pls enter the count Num(1-5):",
                    -anchor=>;'e',
                   -background=>;'#C8CCC8')->;pack(
                    -pady=>;10,-padx=>;6,
                    -expand=>;0,-side=>;'left');
$submit_entry=$frame_submit->;Entry(-textvariable=>;\$Num,
                        -width=>;'3')->;pack(
                        -padx=>;6,-expand=>;0,
                        -side=>;'left');
$submit_button=$frame_submit->;Button(-text=>;'Submit',
                        -command=>;\&submit_confirm,
                        -width=>;'6')->;pack(
                        -expand=>;0,-padx=>;0,
                        -side=>;'left');
my $Num_label=$frame_count->;Label(-text=>;" Total Num:"->;pack(
-side=>;'left',-ipadx=>;6,
-ipady=>;5,-expand=>;0);
my $issue_label=$frame_count->;Label(-text=>;"      Issue Num: ",
-padx=>;1)->;pack(
-side=>;'left',
-ipadx=>;2,
-ipady=>;5,
-expand=>;0
);
$frame_date->;Label(-text=>;"  Gen Date: "->;pack(
-side=>;'left');
$frame_pub->;Label(-text=>;"  Publish Date: "->;pack(
-side=>;'left',
-ipady=>;4);
my $rb1="Save the Result";
my $rb2="Send Result to me";
my $rb3="Both";
my @rb={$rb1,$rb2,$rb3};
my $group=$rb3;
foreach(1..3)
{
my $temp=eval("\$rb".$_);
$frame_mail->;Radiobutton(-text=>;$temp,
-value=>;$temp,
-background=>;'#C8CCC8',
-pady=>;4,
-variable=>;\$group,
-relief=>;'groove')->;pack(
-side=>;'left',
-expand=>;1,
-anchor=>;'w',
-ipadx=>;4 ,
-fill=>;'x'
);
}
@stack_entry={};
foreach(1..5) {
my $frame_temp=$frame_body->;Frame()->;pack(
-side=>;'top',
-fill=>;'both');
$frame_temp->;Label(-text=>;$_ ,
-padx=>;5)->;pack(
-side=>;'left');
foreach(0..6) {
$entry_temp=$frame_temp->;Entry(
-text=>;'0',
-width=>;'3')->;pack(
-side=>;'left',-expand=>;1,
-padx=>;2,-pady=>;6);
push @stack_entry,$entry_temp;
}
}
################
$total_label=$frame_count->;Label(-text=>;'')->;pack(
-side=>;'left',
-expand=>;0,
-after=>;$Num_label
);
$issue_label=$frame_count->;Label(-text=>;" ",-padx=>;1)->;pack(
-side=>;'left',
-ipadx=>;5,
-ipady=>;2,
-fill=>;'x',
-after=>;$issue_label
);
#my $dates=`date`;
#chomp $dates;
$curr_date=$frame_date->;Label(-text=>;'')->;pack(
-side=>;'left',
-fill=>;'x'
);
$pub_label=$frame_pub->;Label(-text=>;'')->;pack(
-side=>;'left',
-fill=>;'x',
-ipady=>;4
);
############
####################### function#########
sub issue {
$week=`date +%a`;
chomp $week;
$weeks=`date +%V`;
$year=`date +%g`;
chomp $year;
my $issu;
$mon="Mon";
$tue="Tue";
$wed="Wed";
$thu="Thu";
$fri="Fri";
$sat="Sat";
$sun="Sun";
$weeks=~s/\^0//;
if (($week eq $sat)||($week eq $sun)) {
$issu=$weeks*3+1;
}elsif (($week eq $wed)||($week eq $tue)) {
$issu=($weeks-1)*3+2;
} elsif (($week eq $thu)||($week eq $fri))
{
$issu=$weeks*3;
}elsif($week eq $mon) {
$issu=($weeks-1)*3+1;
}
else
{;}
if ($issu<10) {
$issu="00$issu";
}elsif ($issu<100 && $issu>;=10) {
$issu="0$issu";
}else {
;
}
my @issues=($year,$issu);
return(@issues);
}
######################
sub per_record() {
my $_A=$_B=$_C=$_D=$_E=$_F=$_G=1;
while ($_A==$_B||$_A==$_C||$_A==$_D||$_A==$_E||$_A==$_F||$_A==$_G||$_B==$_C||$_B==$_D||$_B==$_E||$_B==$_F||$_B==$_G||$_C==$_D||$_C==$_E||$_C==$_F||$_C==$_G||$_D==$_E||$_D==$_F||$_D==$_G||$_E==$_F||$_E==$_G||$_F==$_G) {
$_A=int(rand 36)+1;
$_B=int(rand 36)+1;
$_C=int(rand 36)+1;
$_D=int(rand 36)+1;
$_E=int(rand 36)+1;
$_F=int(rand 36)+1;
$_G=int(rand 36)+1;
}
@per_recode=($_A,$_B,$_C,$_D,$_E,$_F,$_G);
foreach $recode(@per_recode)
{
if ($recode<10) {
$recode="0$recode";
}
}
@result=sort @per_recode;
return(@result);
}
#################body##########
sub submit_confirm {
$Num=~s/\s+//g;
if($Num>;5) {
$Num=5;
}
my $sp=1;
foreach(1..$Num) {
@record=per_record();
foreach(0..6) {
my $pop_entry=\@stack_entry[$sp];
$$pop_entry->;configure(-text=>;\@record[$_]);
$sp++;
}
}
#########addition function for mail ###########
#&save_to(@record);
#if (($group eq $rb3)||($group eq $rb2)) {
#&amp;
#}            -----------if launch this function....too slow!! why??
$submit_button->;packForget();
$reselect_button=$frame_submit->;Button(
-text=>;'Reselect',
-command=>;\&reselect)->;pack(
-side=>;'left',
-expand=>;0,
-padx=>;0);
$exit_button=$frame_submit->;Button(
-text=>;'Exit',
-command=>;sub{exit})->;pack(
-side=>;'left',
-expand=>;0,
-padx=>;3);
my $dates=`date`;
chomp $dates;
my @iss=issue();
my $isss=$iss[0].$iss[1];
my $pubd=publish_date();
$total_label->;configure(-text=>;$Num);
$issue_label->;configure(-text=>;"$isss ";
$curr_date->;configure(-text=>;$dates);
$pub_label->;configure(-text=>;$pubd);
}
sub reselect {
my $sp1=1;
foreach(0..34) {
my $pop_entry=\@stack_entry[$sp1];
$$pop_entry->;configure(-text=>;0);
$sp1++
}
&submit_confirm;
}
###################Additional Function#############
sub send_mail {
my ($to,$from,$subject,@body)=@_;
my $relay="smtp.celestica.com";
my $smtp=Net::SMTP->;new($relay);
die "Could not open connection!" if (! defined $smtp);
$smtp->;mail($from);
$smtp->;to($to);
$smtp->;data();
$smtp->;datasend("Toto \n";
$smtp->;datasend("Fromfrom \n";
$smtp->;datasend("Subjectsubject \n");
$smtp->;datasend("\n");
foreach(@body) {
$smtp->;datasend("$_ \n");}
$smtp->;dataend();
$smtp->;quit;
}
sub save_to {
@insert=@_;
print join(' ',sort @_);
@getis=issue();
$filename=$getis[1];
chomp $filename;
$logfile="/mystuff/perl/tk/pl/$filename.txt";
if (! -e $logfile)
{`>;$logfile`;}
open(LF,">;>;$logfile");
print LF join(' ',sort @insert),"\n";
close(LF);
}
sub mailtome {
my $mail_to="jimmylei\@celestica.com";
my $mail_sub="Lottery Number!";
my $mail_from="LotteryCenter\@lottery.gov.cn";
open(LFF, "$logfile")||die "cannot open file!";
@body=<LFF>;;
close(LFF);
send_mail($mail_to,$mail_from,$mail_sub,@body);
}
sub publish_date {
my $pubdate;
my $today;
if(($week eq $mon)||($week eq $wed)||($week eq $fri)) {
$pubdate=UnixDate('today',"%Y %B %d,%A");
}elsif (($week eq $tue)||($week eq $thu)||($week eq $sun)) {
$today=DateCalc('today',"+1 days");
$pubdate=UnixDate($today,"%Y %B %d,%A");
}
elsif ($week eq $sat) {
$today=DateCalc('today',"+2 days");
$pubdate=UnixDate($today,"%Y %B %d,%A");
}
else {;};
return($pubdate);
}
###############################
MainLoop;