本人用Dancer框架写的个人网站源码（＋1.3011版代码）

aef25u

因最近有人反映代码有问题，检查后发现是由于Dancer版本更新引起的：
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Dancer最新版本－1.3011请下载此附件（2011-03-28更新）： MyDancer.rar (42.7 KB, 下载次数: 350)

2011-03-28 00:25 上传

点击文件名下载附件

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

这是本人用perl的Dancer+DBI+SQLite+TT实现的网站源码
此附件为旧版Dancer： dancer.rar (35.99 KB, 下载次数: 232)

2010-07-22 11:13 上传

点击文件名下载附件
dancer框架实现的网站源码

。

运行环境：Windows XP、strawberry perl、IE

实现了：
    1、Template::Toolkit、SQLite、Authen::Simple:BI、Dancer::Session::Storable在dancer框架中的简单运用。
    2、javascript+css实现二级导航栏
    3、网站Perl代码着色显示
    4、post方法的注册表单、登陆表单和留言本。

内附(位于dancer目录下)：
    start.bat  方便本机运行WEB服务器 (然后在IE中输入http://localhost:3000/)
    SQLite.pl  生成test.db数据库

1、dancer.pl

1. #!/usr/bin/perl
   
2. use DBI;
   
3. use Dancer;
   
4. use MyDancer;
   
5. use Dancer::Plugin::Database;
   
6. 
   
7. my @pages = qw(TtExample SqlExample  registerExample loginExample GuesBookExample configExample layoutTT);
   
8. 
   
9. #与use MyDancer等同;
   
10. #get '/', sub {
    
11. #    layout 'main.tt';
    
12. #    template 'home';
    
13. #};
    
14. 
    
15. get '/:page' => sub {
    
16.     layout 'main.tt';
    
17.     my ($page) = params->{page};
    
18.     pass and return false unless grep /$page/, @pages;
    
19.     template $page;
    
20. };
    
21. 
    
22. get '/tt/scalar', sub {
    
23.     layout 'main.tt';   
    
24.     template 'scalar' =>
    
25.       { content => '欢迎您的到来！希望你也会和我一样喜欢上Perl与Dancer！', };
    
26. };
    
27. 
    
28. get '/tt/table', sub {
    
29.     layout 'main.tt';
    
30.     my $r = [ { a => 1, b => 2, c => 3, },
    
31.               { a => 2, b => 4, c => 6, } ];
    
32.     template 'table' => { r => $r, };
    
33. };
    
34. 
    
35. get '/tt/filter', sub {
    
36.     layout 'main.tt';
    
37.     template 'filter';
    
38. };
    
39. 
    
40. get '/Sql/dbiSqlTest', sub {
    
41.     layout 'main.tt';
    
42.     my $dbh =
    
43.       DBI->connect( "dbi:SQLite:dbname=test.db",,,
    
44.         { RaiseError => 1, AutoCommit => 1 } );
    
45.     my $sth = $dbh->prepare( 'select * from test where id = 1' );
    
46.     $sth->execute;
    
47.     my @row_ary = $sth->fetchrow_array;
    
48.     template 'dbiSqlTest' => { head => 'use DBI', content => $row_ary[1], };
    
49. };
    
50. 
    
51. get '/Sql/PluginSqlTest', sub {
    
52.     layout 'main.tt';
    
53.     my $sth = database->prepare( 'select * from test where id = 1' );
    
54.     $sth->execute;
    
55.     my @row_ary = $sth->fetchrow_array;
    
56.     template 'PluginSqlTest',
    
57.       {
    
58.         head    => 'use Dancer::Plugin::Database',
    
59.         content => $row_ary[1],
    
60.       };
    
61. };
    
62. 
    
63. #表单注册
    
64. get '/book/register' => sub {
    
65.     layout 'login_main';
    
66.     template
    
67.       'register' => { path => 'GuestBook' },
    
68. 
    
69. };
    
70. 
    
71. post '/book/register' => sub {
    
72.     my $sth =
    
73.       database->prepare('SELECT * FROM authentication  WHERE username=?');
    
74.     $sth->execute( params->{username} );
    
75.     if ( $sth->fetch ) {
    
76.         return "User had been registered, sorry";
    
77.     }
    
78.     $sth = database->prepare('INSERT INTO authentication  VALUES(NULL,?,?,?)');
    
79.     $sth->execute(
    
80.         params->{username},
    
81.         params->{password},
    
82.         params->{fmemail},
    
83.     );
    
84. 
    
85.     session user => params->{username};
    
86.     redirect params->{path};
    
87. 
    
88. };
    
89. 
    
90. #GuestBook
    
91. get '/book/GuestBook' => sub {
    
92.     layout 'login_main';
    
93.     my @myarray;
    
94.     my $sth = database->prepare( 'select * from comments order by id asc' );
    
95.     $sth->execute;
    
96.     while(my @row_ary = $sth->fetchrow_array){
    
97.     push @myarray, { user => $row_ary[1], info => $row_ary[2] };
    
98.     }
    
99. 
    
100.     template 'GuestBook' => {message=>\@myarray};  
     
101. 
     
102. };
     
103. 
     
104. post '/book/GuestBook' => sub {
     
105.     my $username=session('user');
     
106.     if (length params->{fmmsg} > 4096) {
     
107.       return "Your comment is too long, sorry";
     
108.     }
     
109.     my $sth =
     
110.       database->prepare('INSERT INTO comments  VALUES(NULL,?,?)');
     
111.     $sth->execute(
     
112.       $username,
     
113.       params->{fmmsg},
     
114.     );
     
115.     session user => $username;
     
116.     redirect 'GuestBook';
     
117. 
     
118. };
     
119. 
     
120. #表单登陆
     
121. load_app 'Pamlogin';
     
122. 
     
123. dance;

复制代码

2、Pamlogin.pm

1. package Pamlogin;
   
2. use Authen::Simple::DBI;
   
3. use Dancer ':syntax';
   
4. 
   
5. # will match '/book/*'
   
6. prefix '/book';
   
7. 
   
8. # will match '/book/login'
   
9. get '/login' => sub {
   
10.     layout 'login_main';
    
11.     template
    
12.       'login' => { path => 'GuestBook' },
    
13. 
    
14. };
    
15. 
    
16. post '/login' => sub {
    
17. 
    
18.     my $dbi = Authen::Simple::DBI->new(
    
19.         dsn       => 'dbi:SQLite:dbname=test.db',
    
20.         statement => 'SELECT password FROM authentication WHERE username = ?'
    
21.     );
    
22. 
    
23.     if ( $dbi->authenticate( params->{username}, params->{password} ) ) {
    
24.         session user => params->{username};
    
25.         redirect params->{path};
    
26.     }
    
27.     else {
    
28.         redirect 'login';
    
29.     }
    
30. };
    
31. 
    
32. get '/logout' => sub {
    
33.     session->destroy;
    
34.     redirect 'GuestBook';
    
35. };
    
36. 
    
37. true;
    

复制代码

兰花仙子

很好。。没用过dancer框架，下来学习下～～{:3_193:}

aef25u

回复 2# 兰花仙子


本人是门外汉，非计算机专业，学perl是兴趣，还请兰花仙子多多指教。

ykredrum

我晕，用cpan安装Dancer失败！
我好像试试

pandaiam

thanks a lot

zhlong8

good

hp_truth

多谢楼主分享， 好好学习

iakuf

太 tm 支持了，近来在让小弟翻译这个，打算项目中用这个

suntoltti

跑起来了，很好。谢谢分享

txh_zyy

我正在学Dancer，谢谢