📜 ⬆️ ⬇️

fast creation of web applications in perl: introductory

Now there is such a situation that the Perl language is undeservedly forgotten. I want to slightly raise the authority of this wonderful language with my notes.
This macro note is aimed at Perl learners, connoisseurs of this language, as well as those who just want to learn more about Perl. In a note I just want to share my experience.

I would like to consider a simple situation, which in my opinion, often takes place when developing small and medium-sized projects. And the situation is this: you need to create a small (medium) site, and the decision is made to abandon the CMS, as the engine needs a small, no frills in the admin panel, the complexity is about 16-24 people / hours. For example, a small site is required, which will contain articles of a certain type (regular text articles) and news. Plus a small admin to add articles and news. We agree that we have a “big” difference between these two types of content in this article.

Problem


In such situations, it is often the decision to write your bike, that is, the engine. Consider just such a situation, on the example of which we will consider the charms of Perl and CPAN .
I don’t offer a full MVC implementation, it’s too much for our small project. For Perl, a wagon and a little framework framework are written (both MVC and not so), such as the excellent Catalyst , which is very, very similar to RubyOnRails (or vice versa, I am not aware of chronology). There are also many smaller ones, for the curious, it’s worth a look here .
')
We, for simplicity, implement a similar mechanism, but simpler. So, let's look at the components of our engine ( LAMP is as default) in the form of modules:
1. Data - DBIx :: Class
2. Display - Template Toolkit
3. Management - do it yourself
A small digression. I have long disliked the cgi-bin folder and try to avoid it in every possible way, almost on all hostings (and especially at home) .htaccess files are allowed. Create such a file in the root folder of the project and write there:
Options +ExecCGI
AddHandler cgi-script pl
DirectoryIndex index.pl

Now you can execute scripts with the .pl extension right in the current directory. In addition, the default page will be our script index.pl.
Next, I advise you to always create a config. There are many variations, everyone likes it in different ways, my minimum is as follows:
package Conf;
use warnings;
use strict;

BEGIN
{
use Exporter;
our (@ISA, @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(
$DB_Host $DB_Port $DB_Name $DB_User $DB_Pass
);
}

our $DB_Host = "host";
our $DB_Port = 3306;
our $DB_Name = "our_db";
our $DB_User = "our_table";
our $DB_Pass = "our_password";
1;


Nothing military, the global parameters of the project are entered here and exported.

Data


DB structure


Let's go back to the engine. The first point is working with data, we will have the DBIx :: Class package for it, which includes several modules. First we will create a simple database with which we will work. It is not necessary to be critical of the structure of the base, it is as simple as possible, just the syntax without everything superfluous, minimizing costs.
create table users (
id smallint not null primary key auto_increment,
name varchar(32) not null,
pass varchar(32) not null);

create table categories (
id int not null primary key auto_increment,
name varchar(128) not null) charset cp1251;

create table articles (
id int not null primary key auto_increment,
category_id int not null,
title varchar(255) not null,
content text not null,
author varchar(128) not null comment 'Author of article',
added_at timestamp not null,
added_by smallint not null comment 'Admin user ID') charset cp1251;

create table news (
id int not null primary key auto_increment,
added_at timestamp not null,
title varchar(255) not null,
content text not null,
is_put_on_main bool not null default 0 comment 'Show on main page?',
added_by smallint not null) charset cp1251;

The user table contains the most basic data (we still do not care about visiting records and others), the categories table contains sections of articles, for example, “auto”, “sports”, “cooking”, etc., the articles table contains the articles itself, and the news table - news. In the latter there is a field is_put_on_main , which is responsible for displaying news on the main one. Also, in almost every table I set the encoding - it is a habit, who are sure - do not do it.

Mapping to code


Well, we have the tables, now we need to display them in the code. The DBIx :: Class module allows you to completely withdraw from writing SQL-code and communicate with tables as with objects. You can work with this module in two ways: either manually describe the structures of each table, or use automation. Consider both ways in order.

Manual method


We look into the code, then there will be explanations. Let's create a folder in the root of our project with the name DB and create four files in it: User.pm, Category.pm, Article.pm, News.pm, here are the contents of these files.
# file User.pm
package DB::User;

use base qw/DBIx::Class/;

__PACKAGE__->load_components(qw/PK::Auto Core/);
__PACKAGE__->table('users');
__PACKAGE__->add_columns(qw/id name pass/);
__PACKAGE__->set_primary_key('id');

__PACKAGE__->has_many('articles' => 'DB::Article',
{ 'foreign.added_by' => 'self.id' });
__PACKAGE__->has_many('news' => 'DB::News',
{ 'foreign.added_by' => 'self.id' });

1;

# file Category.pm
package DB::Category;

use base qw/DBIx::Class/;

__PACKAGE__->load_components(qw/PK::Auto Core/);
__PACKAGE__->table('categories');
__PACKAGE__->add_columns(qw/id name/);
__PACKAGE__->set_primary_key('id');

__PACKAGE__->has_many('articles' => 'DB::Article',
{ 'foreign.category_id' => 'self.id' });

1;

# file Article.pm
package DB::Article;

use base qw/DBIx::Class/;

__PACKAGE__->load_components(qw/InflateColumn::DateTime PK::Auto Core/);
__PACKAGE__->table('articles');
__PACKAGE__->add_columns(qw/id category_id title content added_by author/);
__PACKAGE__->add_columns('added_at' => { data_type => 'timestamp' });
__PACKAGE__->set_primary_key('id');

__PACKAGE__->belongs_to('category' => 'DB::Category',
{ 'foreign.id' => 'self.category_id' });
__PACKAGE__->belongs_to('user' => 'DB::User',
{ 'foreign.id' => 'self.added_by' });

1;

# file News.pm
package DB::News;

use base qw/DBIx::Class/;

__PACKAGE__->load_components(qw/InflateColumn::DateTime PK::Auto Core/);
__PACKAGE__->table('news');
__PACKAGE__->add_columns(qw/id title content is_put_on_main added_by/);
__PACKAGE__->add_columns('added_at' => { data_type => 'timestamp' });
__PACKAGE__->set_primary_key('id');

__PACKAGE__->belongs_to('user' => 'DB::User',
{ 'foreign.id' => 'self.added_by' });

1;

So, a little explanation. We have four very similar files, first we declare the base module DBIx :: Class, then using the __PACKAGE__ mechanism we call its methods, namely: load_components - we load the components for our module (PK :: Auto for working with autoincreased primary_key, Core is the main set for working with links, rows and columns). Next, specify the table, and then add the column names. To work with columns such as datetime, date, and timestamp, use the small module InflateColumn :: DateTime . With it, the fields of the specified types can be used in the program as objects of the DateTime type, with all the attendant conveniences. Then we specify the primary key (if it is composite, then we specify several fields set_primary_key (qw / name1 name2 /);.
Next are familiar to those who know RubyOnRails methods has_many (), belongs_to () and others. These methods are designed to create relationships between tables.
Documentation on the wonderful DBIx :: Class module, where everything is described in detail, including the tutorial and the cookbook.

Now we need to use this miracle, for this we need the module DBIx :: Class :: Shema , which is an abstraction of the data schema. In the root folder of the project we create a file with the name identical to the name of the folder with the classes describing the tables, in our case it will be DB.pm. This is how it looks from me.
package SDB;

use base qw/DBIx::Class::Schema/;
use Conf;

__PACKAGE__->load_classes();

sub GetSchema()
{
my $dsn = "dbi:mysql:$DB_Name:$DB_Host";
my $sch = __PACKAGE__->connect($dsn, $DB_User, $DB_Pass);

return $sch;
}

1;

In general, DBIx :: Class :: Schema can be used without the GetShema () function ; the load_classes () method automatically loads all files found in the folder of the same name. I added a small function that would be more convenient to get the scheme. Without this function, the connection in the code would look like this:
my $dsn = "dbi:mysql:$DB_Name:$DB_Host";
my $sch = DB->connect($dsn, $DB_User, $DB_Pass);

In the case of the function, you can write them a little or in different ways configure the connection with different types of databases.

Automatic method


In the “manual” example, we manually set all the relationships between the tables. There is a DBIx :: Class :: Shema :: Loader module that automatically loads and creates classes. To do this, add a description of foreign keys to the database structure. Using their loader will automatically create the necessary connections. Here's what it looks like:
package DB;
use base qw/DBIx::Class::Schema::Loader/;

__PACKAGE__->loader_options(
inflect_singular => 1,
components => qw/InflateColumn::DateTime/
);

1;

#

use DB;
my $sch = DB->connect( $dsn, $user, $password, $attrs);

You can also add the above function GetShema () (see above) and use it. In this case, the DB folder and four files in it become unnecessary and we have one file description of the scheme. The loader supports many options that define the namespace for the classes to be created, parameters for generating class names, and others.

Use schema


Now let's see how this all together is used directly in the code.
use DB;

my $sch = DB->GetShema();
# id
my $user = $sch->resultset('User')->find({ id => $id });

#
my $new_id = $sch->resultset('Category')->populate(
[
[qw/title content is_put_on_main added_by/],
[$ntitle, $ncontent, 0, $user_id]
]);

#
$sch->resultset('Article')->find({ id => $aid })->delete;

Next, we show our data.

Display


I use the Template Toolkit template system. There are several other systems, such as Mason , but historically, my choice fell on the Template Toolkit.
The Template Toolkit is a template processing system. Let's see its use at once on an example. To begin with, we will create a tmpl folder in the project root and create the site folder in it. In the tmpl / site folder, create a site file with the following contents:
Portal


[% PROCESS $content %]





Next, we will do the same start_page file:
News and articles

Here is such a simple file with one line. This will be the preparation of our start page. Let's tie it all together and get something like our index.pl script code :
#!/usr/bin/perl -w

use strict;

use CGI;
use Template;

use Conf;
use DB;

# CGI
my $q = CGI->new;
my %p = $q->Vars;

# ...
my $tmpl = Template->new(
{
INCLUDE_PATH => 'tmpl/site',
INTERPOLATE => 1,
EVAL_PERL => 1
}) || die "$Template::ERROR\n";

# ...
my $sch = DB->GetShema();

#
my $tmpl_vars = {};
$tmpl_vars->{content} = 'start_page';

print $q->header(-type => 'text/html', -charset => 'windows-1251');
$tmpl->process('site', $tmpl_vars) || die $tmpl->error(), "\n";

I think everyone understands two lines about CGI, then comes the creation of a Template object, the main parameter of which is INCLUDE_PATH - let it be to templates. Below we create the data schema and connect to the database. Next, we create a hash into which we will add all the variables that need to be passed to the template. In our case, we pass only one content variable, this variable is used in the PROCESS directive in the site template. Below, we start processing the template and specify the starting template - site , as well as passing a hash of variables.

The site template uses the PROCESS directive, it starts the nested processing of another template whose name is passed by the parameter, but as we have the name is stored in a variable, then we specify this directly - [% PROCESS $ content%] . Thus, the content of the start_page template is inserted into the site template body . Add a little variety. On the main page we have to display articles and news, but not all, but, say, the last ten. Besides news only those that are marked with the appropriate flag in the table. Before processing the template, add a few lines to our script:
my $articles = [$sch->resultset('Article')->search(undef,
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
my $news = [$sch->resultset('News')->search(
{
is_put_on_main => 1
},
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
$tmpl_vars->{articles} = $articles;
$tmpl_vars->{news} = $news;

It should be noted that we used [] to create a list context, otherwise in a scalar context, the search () function returns an object of type ResultSet , and we just need an array of data.

So, it does not make sense to describe in detail, since everything is quite obvious. The only thing is the use of the rows / page parameters. They are needed to create the so-called pager-s, with which it is convenient to organize pagination, as well as used for simple selection of records, which is a special case. Also the number of articles and news can be put in the config.

Next, change the start_page template:


[% FOREACH n = news %]
[% n.added_at.dmy('.') %] [% n.title %]

[% n.content FILTER html %]

[% END %]

[% FOREACH a = articles %]
[% a.added_at.dmy('.') %] [% a.title %]

: [% a.category.name %]
[% a.content FILTER html %]

[% END %]


[% FOREACH n = news %]
[% n.added_at.dmy('.') %] [% n.title %]

[% n.content FILTER html %]

[% END %]

[% FOREACH a = articles %]
[% a.added_at.dmy('.') %] [% a.title %]

: [% a.category.name %]
[% a.content FILTER html %]

[% END %]


[% FOREACH n = news %]
[% n.added_at.dmy('.') %] [% n.title %]

[% n.content FILTER html %]

[% END %]

[% FOREACH a = articles %]
[% a.added_at.dmy('.') %] [% a.title %]

: [% a.category.name %]
[% a.content FILTER html %]

[% END %]


[% FOREACH n = news %]
[% n.added_at.dmy('.') %] [% n.title %]

[% n.content FILTER html %]

[% END %]

[% FOREACH a = articles %]
[% a.added_at.dmy('.') %] [% a.title %]

: [% a.category.name %]
[% a.content FILTER html %]

[% END %]

I will note the use of the added_at field as an object. For it, the dmy () method is called , which formats the date in DD-MM-YYYY format with the passed separator, in our case, a period. The DateTime object supports locales and correctly displays the date depending on the current (or selected) locale. It also contains many methods for formatting and working with dates.

I haven't intentionally added valid links yet, I'll do it later.
In general, we see two similar blocks that should be placed in a hotel file. Create a short_note file in the tmpl / site folder:
[% text = node.content;
IF text.length > 512;
text = text.substr(0, 512);
END %]
[% note.added_at.dmy('.') %] [% note.title %]

[% IF note.category %]
: [% note.category.name %]
[% END %]
[% text FILTER html %]


Now our start_page template will look like this:


[% FOREACH n = news %]
[% PROCESS short_note note = n %]
[% END %]

[% FOREACH a = articles %]
[% PROCESS short_note note = a %]
[% END %]


[% FOREACH n = news %]
[% PROCESS short_note note = n %]
[% END %]

[% FOREACH a = articles %]
[% PROCESS short_note note = a %]
[% END %]


[% FOREACH n = news %]
[% PROCESS short_note note = n %]
[% END %]

[% FOREACH a = articles %]
[% PROCESS short_note note = a %]
[% END %]


[% FOREACH n = news %]
[% PROCESS short_note note = n %]
[% END %]

[% FOREACH a = articles %]
[% PROCESS short_note note = a %]
[% END %]

Now we call the processing of the short_note template and pass the current news or article as a note parameter.

The template checks for the presence of the category field, which will be a sign of the article, in this case we display the section name.

Our portal also requires templates for displaying the full article or news, displaying a list of article categories, a search form and search results. In general, a few more templates will be added, which will differ little from the above in terms of complexity.

Control


Above, we agreed not to use all kinds of frameworks, we will try to do a minimum with our own hands. To do this, we make the following simple structure (lamer, yes):
my $act = $p{'a'} || 'start';

if ($act eq 'start')
{
}
elsif ($act eq 'article')
{
}
elsif ($act eq 'news')
{
}
# ....
else
{
}

So, each link in the script will be accompanied by the parameter a - action . It will set the current context. Thus, the links above in the templates can be changed to the following:

, . id , . :
$p{'id'} =~ s/\D//g if ($p{'id'});

, - , , , -. .

.
if ($act eq 'start')
{
$tmpl_vars->{content} = 'start_page';
my $articles = [$sch->resultset('Article')->search(undef,
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
my $news = [$sch->resultset('News')->search(
{
is_put_on_main => 1
},
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
$tmpl_vars->{articles} = $articles;
$tmpl_vars->{news} = $news;
}
elsif ($act eq 'article')
{
$tmpl_vars->{content} = 'full_article';
$tmpl_vars->{article} = $sch->resultset('Article')->find({ id => $p{'id'} });
}
elsif ($act eq 'category')
{
$tmpl_vars->{content} = 'category';
$tmpl_vars->{category} = $sch->resultset('Category')->find({ id => $p{'id'} });
}
elsif ($act eq 'news')
{
$tmpl_vars->{content} = 'full_article';
$tmpl_vars->{article} = $sch->resultset('News')->find({ id => $p{'id'} });
}
else
{
# .
}

, , . , Perl , , HTML-CheckArgs HTML-QuickCheck . , HTML-Widget HTML-Tag . . , . .

: , . ( , error_action , ), :
print $q->header(-location => '?a=start');
exit;

, . , , ( ):
my %action = (
'start' => 'Main page',
'news' => 'News page',
'article' => 'Full article',
# ....
);
my $act = ( $p{'act'} && defined( $actions{$p{'act'}} )) ? $p{'act'} : 'start';

, — , 'start'. - defined(...) .


. , . , tmpl/admin .
: Digest::SHA1 CGI::Session . , — .
, . .

:
[%# login %]
[% IF err %]
Wrong login
[% END %]
/>
Login: />
Password: />
/>



, :
use CGI::Session;
use Digest::SHA1 qw(sha1_hex);

# ... CGI
my $s = CGI::Session->load(undef, undef, { Directory => 'ssss' } );

# ...
if ($s->empty && $act !~ /login(_form)?|logout/)
{
print $q->header(-location => '?a=login_form');
exit;
}
else
{
my $user = $sch->resultset('User')->find({ id => $s->param('uid') });
$tmpl_vars->{user} = $user;
}

if ($act eq 'login_form')
{
$tmpl_vars->{content} = 'login_form';
}
elsif ($act eq 'login')
{
unless (my $u = &login($p{'login'}, $p{'pass'}))
{
$tmpl_vars->{content} = 'login';
$tmpl_vars->{err} = 1;
}
else
{
$s = $s->new;
$s->param('uid', $u->id);

print $s->header(-location => '?a=start');
exit;
}
}
elsif ($act eq 'logout')
{
$s->delete;
print $q->header(-location => '?a=login');
exit;
}

#
sub login
{
my ($u, $p) = @_;

my $pp = sha1_hex($p);
my $res = $sch->resultset('User')->search({
name => $u,
pass => $pp
});

my $user = $res->next;
return $user;
}


, , .
CGI::Session , . — expired. ssss .
Digest::SHA1 - MD5.

. -, CRUD- (CReate, Update, Delete). , , DBIx::Class::WebForm . CRUD CPAN .
-, . FCKeditor , . .
-, . , DBIx::Class::Validation , , , CGI::FormBuilder , CGI::QuickForm .. "Form", "Validate" "Widget" .


"" . , , , . , , . , SQL-.

, - . .

-NOT_FOR_HOLYWARS-


, . id , . :
$p{'id'} =~ s/\D//g if ($p{'id'});

, - , , , -. .

.
if ($act eq 'start')
{
$tmpl_vars->{content} = 'start_page';
my $articles = [$sch->resultset('Article')->search(undef,
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
my $news = [$sch->resultset('News')->search(
{
is_put_on_main => 1
},
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
$tmpl_vars->{articles} = $articles;
$tmpl_vars->{news} = $news;
}
elsif ($act eq 'article')
{
$tmpl_vars->{content} = 'full_article';
$tmpl_vars->{article} = $sch->resultset('Article')->find({ id => $p{'id'} });
}
elsif ($act eq 'category')
{
$tmpl_vars->{content} = 'category';
$tmpl_vars->{category} = $sch->resultset('Category')->find({ id => $p{'id'} });
}
elsif ($act eq 'news')
{
$tmpl_vars->{content} = 'full_article';
$tmpl_vars->{article} = $sch->resultset('News')->find({ id => $p{'id'} });
}
else
{
# .
}

, , . , Perl , , HTML-CheckArgs HTML-QuickCheck . , HTML-Widget HTML-Tag . . , . .

: , . ( , error_action , ), :
print $q->header(-location => '?a=start');
exit;

, . , , ( ):
my %action = (
'start' => 'Main page',
'news' => 'News page',
'article' => 'Full article',
# ....
);
my $act = ( $p{'act'} && defined( $actions{$p{'act'}} )) ? $p{'act'} : 'start';

, — , 'start'. - defined(...) .


. , . , tmpl/admin .
: Digest::SHA1 CGI::Session . , — .
, . .

:
[%# login %]
[% IF err %]
Wrong login
[% END %]
/>
Login: />
Password: />
/>



, :
use CGI::Session;
use Digest::SHA1 qw(sha1_hex);

# ... CGI
my $s = CGI::Session->load(undef, undef, { Directory => 'ssss' } );

# ...
if ($s->empty && $act !~ /login(_form)?|logout/)
{
print $q->header(-location => '?a=login_form');
exit;
}
else
{
my $user = $sch->resultset('User')->find({ id => $s->param('uid') });
$tmpl_vars->{user} = $user;
}

if ($act eq 'login_form')
{
$tmpl_vars->{content} = 'login_form';
}
elsif ($act eq 'login')
{
unless (my $u = &login($p{'login'}, $p{'pass'}))
{
$tmpl_vars->{content} = 'login';
$tmpl_vars->{err} = 1;
}
else
{
$s = $s->new;
$s->param('uid', $u->id);

print $s->header(-location => '?a=start');
exit;
}
}
elsif ($act eq 'logout')
{
$s->delete;
print $q->header(-location => '?a=login');
exit;
}

#
sub login
{
my ($u, $p) = @_;

my $pp = sha1_hex($p);
my $res = $sch->resultset('User')->search({
name => $u,
pass => $pp
});

my $user = $res->next;
return $user;
}


, , .
CGI::Session , . — expired. ssss .
Digest::SHA1 - MD5.

. -, CRUD- (CReate, Update, Delete). , , DBIx::Class::WebForm . CRUD CPAN .
-, . FCKeditor , . .
-, . , DBIx::Class::Validation , , , CGI::FormBuilder , CGI::QuickForm .. "Form", "Validate" "Widget" .


"" . , , , . , , . , SQL-.

, - . .

-NOT_FOR_HOLYWARS-


, . id , . :
$p{'id'} =~ s/\D//g if ($p{'id'});

, - , , , -. .

.
if ($act eq 'start')
{
$tmpl_vars->{content} = 'start_page';
my $articles = [$sch->resultset('Article')->search(undef,
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
my $news = [$sch->resultset('News')->search(
{
is_put_on_main => 1
},
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
$tmpl_vars->{articles} = $articles;
$tmpl_vars->{news} = $news;
}
elsif ($act eq 'article')
{
$tmpl_vars->{content} = 'full_article';
$tmpl_vars->{article} = $sch->resultset('Article')->find({ id => $p{'id'} });
}
elsif ($act eq 'category')
{
$tmpl_vars->{content} = 'category';
$tmpl_vars->{category} = $sch->resultset('Category')->find({ id => $p{'id'} });
}
elsif ($act eq 'news')
{
$tmpl_vars->{content} = 'full_article';
$tmpl_vars->{article} = $sch->resultset('News')->find({ id => $p{'id'} });
}
else
{
# .
}

, , . , Perl , , HTML-CheckArgs HTML-QuickCheck . , HTML-Widget HTML-Tag . . , . .

: , . ( , error_action , ), :
print $q->header(-location => '?a=start');
exit;

, . , , ( ):
my %action = (
'start' => 'Main page',
'news' => 'News page',
'article' => 'Full article',
# ....
);
my $act = ( $p{'act'} && defined( $actions{$p{'act'}} )) ? $p{'act'} : 'start';

, — , 'start'. - defined(...) .


. , . , tmpl/admin .
: Digest::SHA1 CGI::Session . , — .
, . .

:
[%# login %]
[% IF err %]
Wrong login
[% END %]
/>
Login: />
Password: />
/>



, :
use CGI::Session;
use Digest::SHA1 qw(sha1_hex);

# ... CGI
my $s = CGI::Session->load(undef, undef, { Directory => 'ssss' } );

# ...
if ($s->empty && $act !~ /login(_form)?|logout/)
{
print $q->header(-location => '?a=login_form');
exit;
}
else
{
my $user = $sch->resultset('User')->find({ id => $s->param('uid') });
$tmpl_vars->{user} = $user;
}

if ($act eq 'login_form')
{
$tmpl_vars->{content} = 'login_form';
}
elsif ($act eq 'login')
{
unless (my $u = &login($p{'login'}, $p{'pass'}))
{
$tmpl_vars->{content} = 'login';
$tmpl_vars->{err} = 1;
}
else
{
$s = $s->new;
$s->param('uid', $u->id);

print $s->header(-location => '?a=start');
exit;
}
}
elsif ($act eq 'logout')
{
$s->delete;
print $q->header(-location => '?a=login');
exit;
}

#
sub login
{
my ($u, $p) = @_;

my $pp = sha1_hex($p);
my $res = $sch->resultset('User')->search({
name => $u,
pass => $pp
});

my $user = $res->next;
return $user;
}


, , .
CGI::Session , . — expired. ssss .
Digest::SHA1 - MD5.

. -, CRUD- (CReate, Update, Delete). , , DBIx::Class::WebForm . CRUD CPAN .
-, . FCKeditor , . .
-, . , DBIx::Class::Validation , , , CGI::FormBuilder , CGI::QuickForm .. "Form", "Validate" "Widget" .


"" . , , , . , , . , SQL-.

, - . .

-NOT_FOR_HOLYWARS-


, . id , . :
$p{'id'} =~ s/\D//g if ($p{'id'});

, - , , , -. .

.
if ($act eq 'start')
{
$tmpl_vars->{content} = 'start_page';
my $articles = [$sch->resultset('Article')->search(undef,
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
my $news = [$sch->resultset('News')->search(
{
is_put_on_main => 1
},
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
$tmpl_vars->{articles} = $articles;
$tmpl_vars->{news} = $news;
}
elsif ($act eq 'article')
{
$tmpl_vars->{content} = 'full_article';
$tmpl_vars->{article} = $sch->resultset('Article')->find({ id => $p{'id'} });
}
elsif ($act eq 'category')
{
$tmpl_vars->{content} = 'category';
$tmpl_vars->{category} = $sch->resultset('Category')->find({ id => $p{'id'} });
}
elsif ($act eq 'news')
{
$tmpl_vars->{content} = 'full_article';
$tmpl_vars->{article} = $sch->resultset('News')->find({ id => $p{'id'} });
}
else
{
# .
}

, , . , Perl , , HTML-CheckArgs HTML-QuickCheck . , HTML-Widget HTML-Tag . . , . .

: , . ( , error_action , ), :
print $q->header(-location => '?a=start');
exit;

, . , , ( ):
my %action = (
'start' => 'Main page',
'news' => 'News page',
'article' => 'Full article',
# ....
);
my $act = ( $p{'act'} && defined( $actions{$p{'act'}} )) ? $p{'act'} : 'start';

, — , 'start'. - defined(...) .


. , . , tmpl/admin .
: Digest::SHA1 CGI::Session . , — .
, . .

:
[%# login %]
[% IF err %]
Wrong login
[% END %]
/>
Login: />
Password: />
/>



, :
use CGI::Session;
use Digest::SHA1 qw(sha1_hex);

# ... CGI
my $s = CGI::Session->load(undef, undef, { Directory => 'ssss' } );

# ...
if ($s->empty && $act !~ /login(_form)?|logout/)
{
print $q->header(-location => '?a=login_form');
exit;
}
else
{
my $user = $sch->resultset('User')->find({ id => $s->param('uid') });
$tmpl_vars->{user} = $user;
}

if ($act eq 'login_form')
{
$tmpl_vars->{content} = 'login_form';
}
elsif ($act eq 'login')
{
unless (my $u = &login($p{'login'}, $p{'pass'}))
{
$tmpl_vars->{content} = 'login';
$tmpl_vars->{err} = 1;
}
else
{
$s = $s->new;
$s->param('uid', $u->id);

print $s->header(-location => '?a=start');
exit;
}
}
elsif ($act eq 'logout')
{
$s->delete;
print $q->header(-location => '?a=login');
exit;
}

#
sub login
{
my ($u, $p) = @_;

my $pp = sha1_hex($p);
my $res = $sch->resultset('User')->search({
name => $u,
pass => $pp
});

my $user = $res->next;
return $user;
}


, , .
CGI::Session , . — expired. ssss .
Digest::SHA1 - MD5.

. -, CRUD- (CReate, Update, Delete). , , DBIx::Class::WebForm . CRUD CPAN .
-, . FCKeditor , . .
-, . , DBIx::Class::Validation , , , CGI::FormBuilder , CGI::QuickForm .. "Form", "Validate" "Widget" .


"" . , , , . , , . , SQL-.

, - . .

-NOT_FOR_HOLYWARS-


, . id , . :
$p{'id'} =~ s/\D//g if ($p{'id'});

, - , , , -. .

.
if ($act eq 'start')
{
$tmpl_vars->{content} = 'start_page';
my $articles = [$sch->resultset('Article')->search(undef,
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
my $news = [$sch->resultset('News')->search(
{
is_put_on_main => 1
},
{
order_by => 'added_at desc',
rows => 10,
page => 1
})];
$tmpl_vars->{articles} = $articles;
$tmpl_vars->{news} = $news;
}
elsif ($act eq 'article')
{
$tmpl_vars->{content} = 'full_article';
$tmpl_vars->{article} = $sch->resultset('Article')->find({ id => $p{'id'} });
}
elsif ($act eq 'category')
{
$tmpl_vars->{content} = 'category';
$tmpl_vars->{category} = $sch->resultset('Category')->find({ id => $p{'id'} });
}
elsif ($act eq 'news')
{
$tmpl_vars->{content} = 'full_article';
$tmpl_vars->{article} = $sch->resultset('News')->find({ id => $p{'id'} });
}
else
{
# .
}

, , . , Perl , , HTML-CheckArgs HTML-QuickCheck . , HTML-Widget HTML-Tag . . , . .

: , . ( , error_action , ), :
print $q->header(-location => '?a=start');
exit;

, . , , ( ):
my %action = (
'start' => 'Main page',
'news' => 'News page',
'article' => 'Full article',
# ....
);
my $act = ( $p{'act'} && defined( $actions{$p{'act'}} )) ? $p{'act'} : 'start';

, — , 'start'. - defined(...) .


. , . , tmpl/admin .
: Digest::SHA1 CGI::Session . , — .
, . .

:
[%# login %]
[% IF err %]
Wrong login
[% END %]
/>
Login: />
Password: />
/>



, :
use CGI::Session;
use Digest::SHA1 qw(sha1_hex);

# ... CGI
my $s = CGI::Session->load(undef, undef, { Directory => 'ssss' } );

# ...
if ($s->empty && $act !~ /login(_form)?|logout/)
{
print $q->header(-location => '?a=login_form');
exit;
}
else
{
my $user = $sch->resultset('User')->find({ id => $s->param('uid') });
$tmpl_vars->{user} = $user;
}

if ($act eq 'login_form')
{
$tmpl_vars->{content} = 'login_form';
}
elsif ($act eq 'login')
{
unless (my $u = &login($p{'login'}, $p{'pass'}))
{
$tmpl_vars->{content} = 'login';
$tmpl_vars->{err} = 1;
}
else
{
$s = $s->new;
$s->param('uid', $u->id);

print $s->header(-location => '?a=start');
exit;
}
}
elsif ($act eq 'logout')
{
$s->delete;
print $q->header(-location => '?a=login');
exit;
}

#
sub login
{
my ($u, $p) = @_;

my $pp = sha1_hex($p);
my $res = $sch->resultset('User')->search({
name => $u,
pass => $pp
});

my $user = $res->next;
return $user;
}


, , .
CGI::Session , . — expired. ssss .
Digest::SHA1 - MD5.

. -, CRUD- (CReate, Update, Delete). , , DBIx::Class::WebForm . CRUD CPAN .
-, . FCKeditor , . .
-, . , DBIx::Class::Validation , , , CGI::FormBuilder , CGI::QuickForm .. "Form", "Validate" "Widget" .


"" . , , , . , , . , SQL-.

, - . .

-NOT_FOR_HOLYWARS-

Source: https://habr.com/ru/post/23543/


All Articles