現在、Perl言語が不当に忘れられている状況があります。 私はこの素晴らしい言語の権威をメモで少し上げたいです。
このマクロノートは、Perlの学習者、この言語の専門家、およびPerlの詳細を知りたいだけの人を対象としています。 記事では、私の経験だけを共有したいと思います。

私の意見では、中小規模のプロジェクトを開発する際によく起こる簡単な状況を考えたいと思います。 そして状況はこれです：小さな（中）サイトを作成する必要があり、CMSを放棄する決定が下されます、エンジンが小さいので、管理パネルにベルやホイッスルの必要はなく、複雑さは約16-24人/時間です たとえば、特定の種類の記事（通常のテキスト記事）とニュースを含む小さなサイトが必要です。 さらに、記事やニュースを追加するための小さな管理パネル。 この記事の2種類のコンテンツには「大きな」違いがあることに同意しましょう。

問題

そのような状況では、多くの場合、自転車、つまりエンジンを書くという決定が下されます。 そのような状況を考えてみましょう。その例では、PerlとCPANの楽しさも考慮します。
MVCの本格的な実装は提供していません。これは私たちの小さなプロジェクトには多すぎます。 キャリッジとフレームワークの小さなカート（MVCとそうでない両方）がPerl用に書かれました。たとえば、優れたCatalystは 、RubyOnRailsと非常によく似ています（またはその逆、私は年表を知りません）。 小さいものも多数あります 。好奇心the盛な方は、 こちらをご覧ください 。

簡単にするために、同様のメカニズムを実装していますが、よりシンプルです。 それでは、モジュールの形式でエンジンのコンポーネント（ LAMPがデフォルトです）を見てみましょう。
1.データ-DBIx ::クラス
2.表示-テンプレートツールキット
3.管理-自分で行う
小さな余談。 私は長い間cgi-binフォルダーが好きではありません。可能な限りあらゆる方法で.htaccessファイルを許可しようとしています（ほとんどすべてのホスティングサービスで（さらには自宅でも）。 このようなファイルをプロジェクトのルートフォルダーに作成し、そこに書き込みます。
Options +ExecCGI
AddHandler cgi-script pl
DirectoryIndex index.pl

これで、現在のディレクトリで拡張子.plのスクリプトを直接実行できます。 さらに、デフォルトのページはindex.plスクリプトになります。
次に、常に設定を作成することをお勧めします。 多くのバリエーションがありますが、誰もが異なって好きです、私にとっては最小限に見えます：
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;


ここでは軍事的、グローバルなプロジェクトパラメータは導入されず、エクスポートされません。

データ

DB構造

エンジンに戻ります。 最初のポイントはデータの操作です。DBIx:: Classパッケージにはいくつかのモジュールが含まれています。 まず、作業に使用する単純なデータベースを作成します。 データベースの構造に批判的である必要はありません。可能な限り単純で、余分な構文がないだけで、コストを最小限に抑えます。
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;

ユーザーテーブルには最も基本的なデータが含まれ（訪問数などはまだ気になりません）、 カテゴリテーブルには記事のセクション（「自動」、「スポーツ」、「料理」など）が含まれ、 記事テーブルには実際の記事、 ニューステーブルが含まれます-ニュース。 後者には、メインのニュースを表示するフィールドis_put_on_mainがあります。 また、ほとんどすべてのテーブルで、エンコーディングを設定します-これは習慣です、確かに-しないでください。

コードへのマッピング

さて、テーブルがあります。今度はコードでそれらを表示する必要があります。 DBIx :: Classモジュールを使用すると、SQLコードの記述から完全に離れ、オブジェクトとしてテーブルと通信できます。 このモジュールを使用するには、2つの方法があります。各テーブルの構造を手動で記述するか、自動化を使用します。 両方の方法を順番に考えてみましょう。

手作業による方法

コードを見て、さらに説明があります。 プロジェクトのルートにDBというフォルダーを作成し、その中に4つのファイルを作成します：User.pm、Category.pm、Article.pm、News.pm、これらのファイルの内容は次のとおりです。
# 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;

だから、少し説明。 4つの非常に類似したファイルがあり、最初に基本モジュールDBIx :: Classを宣言し、次に__PACKAGE__メカニズムを使用してそのメソッドを呼び出します： load_components-モジュールのコンポーネントをロードしますリンク、行、列を含む）。 次に、テーブルを指定し、その後に列の名前を追加します。 日時、日付、タイムスタンプなどのタイプの列を操作するには、小さなモジュールInflateColumn :: DateTimeが使用されます。 これを使用すると、示されたタイプのフィールドは、 DateTimeタイプのオブジェクトとしてプログラムで使用でき、すべての後続のアメニティを使用できます。 その後、主キーを指定します（複合キーの場合は、複数のフィールドset_primary_key（qw / name1 name2 /）を指定します;）。
次に、RubyOnRails、has_many（）、belongs_to（）、およびその他を知っている人にとって馴染みのあるメソッドがあります。 これらのメソッドは、テーブル間の関係を作成するように設計されています。
すばらしいDBIx :: Classモジュールのドキュメント 。チュートリアルやクックブックなど、すべてが詳細に説明されています。

次に、この奇跡を使用する必要があります。そのためには、 DBIx :: Class :: Shemaモジュールが必要です。これは、データスキームの抽象化です。 プロジェクトのルートフォルダーに、テーブルを記述するクラスを持つフォルダーの名前と同じ名前のファイルを作成します。この場合はDB.pmになります。
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;

一般に、 GetShema（）関数なしでDBIx :: Class :: Schemaを使用できます。load_classes （）メソッドは、同じ名前のフォルダーで見つかったすべてのファイルを自動的にロードします。 回路を取得する方が便利になるように、小さな関数を追加しました。 この関数がないと、コード内の接続は次のようになります。
my $dsn = "dbi:mysql:$DB_Name:$DB_Host";
my $sch = DB->connect($dsn, $DB_User, $DB_Pass);

funkiyaの場合、それらのいくつかを記述したり、異なるタイプのベースとの接続を別々に構成したりできます。

自動方法

「手動」の例では、テーブル間のすべての関係を手動で設定します。 クラスを自動的にロードおよび作成するDBIx :: Class :: Shema :: Loaderモジュールがあります。 これを行うには、外部キーの説明をデータベース構造に追加します。 ローダーを使用すると、必要な接続が自動的に作成されます。 これは次のようなものです。
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);

上記のGetShema（）関数を追加（上記を参照）して使用することもできます。 この場合、DBフォルダーとその中の4つのファイルは不要になり、スキーマ記述ファイルはまだ1つあります。 ローダーは、作成するクラスの名前空間、クラス名を生成するためのパラメーターなどを指定する多くのオプションをサポートしています 。

スキーマを使用する

次に、これらすべてがコードで直接使用される方法を見てみましょう。
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;

次に、データを表示します。

ディスプレイ

Template Toolkitを使用します 。 さらにいくつかのシステム、たとえばMasonがありますが、歴史的にそうなったため、私の選択はTemplate Toolkitに委ねられました。
Template Toolkitは、テンプレート処理システムです。 例でその使用方法を見てみましょう。 まず、プロジェクトルートにtmplフォルダーを作成し、その中にサイトフォルダーを作成します。 tmpl / siteフォルダーで、次の内容のサイトファイルを作成します。
Portal


[% PROCESS $content %]





次に、そこにstart_pageファイルを作成します。
News and articles

これは、1行の単純なファイルです。 これは、スタートページの空白になります。 すべてをまとめて、 index.plスクリプト用に次のコードのようなものを取得します。
#!/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";

誰もがCGIについての2行を理解していると思います。次にテンプレートテンプレートを作成します。テンプレートのメインパラメータはINCLUDE_PATHです。 もう少し、データスキームを作成し、データベースに接続します。 次に、テンプレートに渡す必要のあるすべての変数を追加するハッシュを作成します。 この場合、1つの変数contentのみを渡します。この変数は、 サイトテンプレートのPROCESSディレクティブで使用されます。 さらに低いのは、テンプレートの処理を開始し、開始テンプレート-siteを指定し、変数のハッシュを転送することです。

サイトテンプレートはPROCESSディレクティブを使用し、名前がパラメーターとして渡される別のテンプレートのネストされた処理を開始しますが、変数に名前が格納されているため、これを直接示します- [％PROCESS $ content％] したがって、 start_pageテンプレートのコンテンツは、 サイトテンプレートの本文に挿入されます。 少しバラエティを追加します。 メインページでは、記事とニュースを表示する必要がありますが、すべてではなく、最後の10件を表示する必要があります。 また、ニュースは、テーブル内の対応するフラグでマークされているニュースのみです。 テンプレートを処理する前に、スクリプトに数行を追加します。
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;

[]を使用してリストコンテキストを作成したことに注意してください。そうでない場合、スカラーコンテキストでは、 search（）関数はResultSet型のオブジェクトを返し、正確にデータの配列が必要です。

ですから、すべてがかなり明白なので、詳細に説明するのは意味がありません。 唯一のものは、 行/ページパラメータの使用です。 これらは、ページネーションを整理するのに便利な、いわゆるページャーを作成するために必要であり、特殊なケースであるレコードの単純な選択にも使用されます。 また、記事とニュースの数を構成に送信できます。

次に、 start_pageテンプレートを変更します 。


[% 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 %]

added_atフィールドをオブジェクトとして使用していることに注意してください。 そのために、 dmy（）メソッドが呼び出されます 。このメソッドは、指定された区切り文字（この場合はピリオド）を使用してDD-MM-YYYY形式で日付をフォーマットします。 DateTimeオブジェクトはロケールをサポートし、現在の（または選択された）ロケールに応じて日付を正しく表示します。 また、日付の書式設定と操作のための多くのメソッドが含まれています。

有効なリンクをまだ意図的に追加していません。これは後で行います。
一般的に、ホテルファイルに移動する必要がある2つの類似したブロックがあります。 tmpl / siteフォルダーにshort_noteファイルを作成します。
[% 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 %]


これで、 start_pageテンプレートは次のようになります。


[% 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 %]

ここで、 short_noteテンプレートの処理を呼び出し、現在のニュースまたは記事をパラメーターとしてnoteに渡します。

テンプレートは、記事の機能であるカテゴリフィールドの存在を確認します。この場合、セクションの名前を表示します。

ポータルでは、記事全体またはニュースを表示し、記事カテゴリのリスト、検索フォーム、および検索結果を表示するためのテンプレートも必要です。 一般に、複雑さの点で上記とあまり変わらないテンプレートがさらにいくつか追加されます。

運営管理

上記では、すべての種類のフレームワークを使用しないことに同意しました。私たちは自分の手で最小限のことをしようとします。 これを行うために、次の単純な構造を作成します（ラマー、はい）：
my $act = $p{'a'} || 'start';

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

そのため、スクリプト内の各リンクには- アクションパラメーターが付随します。 現在のコンテキストを設定します。 したがって、テンプレート内の上記のリンクは次のように変更できます。

, . 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-