Mercurial > pub > Impl
changeset 64:259cd3df6e53
Doc generation
Minor fixes
author | wizard |
---|---|
date | Mon, 15 Mar 2010 17:45:13 +0300 |
parents | 76b878ad6596 |
children | 2840c4c85db8 |
files | .hgignore Lib/IMPL/DOM/Navigator/Builder.pm Lib/IMPL/Object.pm Lib/IMPL/Object/Factory.pm Lib/IMPL/Web/QueryHandler/PageFormat.pm _doc/make.pl |
diffstat | 6 files changed, 295 insertions(+), 9 deletions(-) [+] |
line wrap: on
line diff
--- a/.hgignore Mon Mar 15 02:38:09 2010 +0300 +++ b/.hgignore Mon Mar 15 17:45:13 2010 +0300 @@ -1,1 +1,4 @@ glob:.svn/ + +syntax: regexp +^_doc/html$ \ No newline at end of file
--- a/Lib/IMPL/DOM/Navigator/Builder.pm Mon Mar 15 02:38:09 2010 +0300 +++ b/Lib/IMPL/DOM/Navigator/Builder.pm Mon Mar 15 17:45:13 2010 +0300 @@ -56,10 +56,17 @@ 1; __END__ + =pod +=head1 NAME + +C< IMPL::DOM::Navigator::Builder > - Навигатор, строящий документ по указанной схеме. + =head1 SYNOPSIS +=begin code + my $builder = new IMPL::DOM::Navigator::Builder(new MyApp::Document,$schema); my $reader = new IMPL::DOM::XMLReader(Navigator => $builder); @@ -67,6 +74,8 @@ my @errors = $schema->Validate($builder->Document); +=end code + =head1 DESCRIPTION Построитель DOM документов по указанной схеме. Обычно используется в связке @@ -76,21 +85,27 @@ =over -=item C<CTOR($domDocument,$schema)> +=item C< CTOR($classDocument,$schema) > -Создает новый объект, принимает на вход пустой (но не обязательно) документ и -схему. +Создает новый объект, принимает на вход класс документа (или фабрику, например +L<IMPL::Object::Factory>) и схему. В процессе процедуры построения документа +будет создан объект документа. -=item C<< $obj->NavigateCreate($nodeName) >> +=item C< NavigateCreate($nodeName,\%props) > Создает новый узел с указанным именем и переходит в него. В случае если в схеме подходящий узел не найден, то вызывается исключение. При этом по имени узла ищется его схема, после чего определяется класс для -создания экземпляра и созданный узел доавляется в документ. +создания экземпляра и созданный узел доавляется в документ. При создании +нового узла используется метод документа C<< IMPL::DOM::Document->Create >> -Также имя создаваемого узла НЕ может быть переопределено свойством nodeName, оно -будет проигнорировано. +Свойства узла передаются при создании через параметр C<props>, но имя создаваемого +узла НЕ может быть переопределено свойством C<nodeName>, оно будет проигнорировано. + +=item C< Document > + +Свойство, которое содержит документ по окончании процедурв построения. =back
--- a/Lib/IMPL/Object.pm Mon Mar 15 02:38:09 2010 +0300 +++ b/Lib/IMPL/Object.pm Mon Mar 15 17:45:13 2010 +0300 @@ -27,6 +27,8 @@ =head1 SYNOPSIS +=begin code + package Foo; use base qw(IMPL::Object); @@ -80,6 +82,8 @@ # Bar: # Composite: Hello World! +=end code + =head1 Description Базовый класс для объектов, основанных на хеше.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Object/Factory.pm Mon Mar 15 17:45:13 2010 +0300 @@ -0,0 +1,124 @@ +package IMPL::Object::Factory; +use strict; + +use base qw(IMPL::Object IMPL::Object::Serializable); + +use IMPL::Class::Property; + +BEGIN { + public property factory => prop_get | owner_set; + public property parameters => prop_get | owner_set; +} + +# custom factory, overrides default +sub new { + my $self = shift; + + return ref $self ? $self->CreateObject(@_) : $self->SUPER::new(@_); +} + +sub CTOR { + my ($this,$factory,$parameters) = @_; + + $this->factory($factory) or die new IMPL::InvalidArgumentException("The argument 'factory' is mandatory"); + $this->parameters($parameters) if $parameters; +} + +# override default restore method +sub restore { + my ($class,$data,$surrogate) = @_; + + my %args = @$data; + + if ($surrogate) { + $surrogate->callCTOR($args{factory},$args{parameters}); + return $surrogate; + } else { + return $class->new($args{factory},$args{parameters}); + } +} + +sub CreateObject { + my $this = shift; + + return $this->factory->new($this->parameters ? (_as_list($this->parameters),@_) : @_); +} + +sub _as_list { + ref $_[0] ? + (ref $_[0] eq 'HASH' ? + %{$_[0]} + : + (ref $_[0] eq 'ARRAY'? + @{$_[0]} + : + $_[0] + ) + ) + : + ($_[0]); +} + + +1; + +__END__ + +=pod + +=head1 SYNOPSIS + +=begin code + +sub ProcessItems { + my ($factory,$items); + + return map $factory->new($_), @$items; +} + +my @users = ProcessItems('MyApp::User',$db->selectUsers); + +my $factory = new IMPL::Object::Factory( + 'MyApp::User', + { + isAdmin => 1 + } +); + +=end code + +my @admins = ProcessItems($factory,$db->selectAdmins); + + +=head1 DESCRIPTION + +Класс, реализующий фабрику классов. + +Фабрика классов это любой объект, который имеет метод C< new > вызов которого приводит к созданию нового +объекта. Например каждый класс сам явялется фабрикой, поскольку, если у него вызвать метод +C< new >, то будет создан объект. Полученные объекты, в силу механизмов языка Perl, также +являются фабриками, притом такимиже, что и класс. + +Данный класс меняет поведение метода C< new > в зависимости от контекста вызова: статического +метода или метода объекта. При вызове метода C< new > у класса происходит создание объекта +фабрики с определенными параметрами. Далее объект-фабрика может быть использована для создания +объектов уже на основе параметров фабрики. + +=head1 MEMBERS + +=over + +=item C< factory > + +Свойство, содержащее фабрику для создание новых объектов текущей фабрикой. Чаще всего оно содержит +имя класса. + +=item C< parameters > + +Свойство, содержит ссылку на параметры для создания объектов, при создании объекта эти параметры будут +развернуты в список и переданы оператору C< new > фабрике из свойства C< factory >, за ними будут +следовать параметры непосредственно текущей фабрики. + +=back + +=cut \ No newline at end of file
--- a/Lib/IMPL/Web/QueryHandler/PageFormat.pm Mon Mar 15 02:38:09 2010 +0300 +++ b/Lib/IMPL/Web/QueryHandler/PageFormat.pm Mon Mar 15 17:45:13 2010 +0300 @@ -1,5 +1,5 @@ package IMPL::Web::QueryHandler::PageFormat; -use base qw(IMPL::Web::QueryHandler); +use base qw(IMPL::Web::QueryHandler IMPL::Object::Autofill); __PACKAGE__->PassThroughArgs; @@ -7,13 +7,23 @@ use IMPL::Web::TDocument; use Error qw(:try); +BEGIN { + public property charsetTemplates => prop_all; +} + +sub CTOR { + my ($this) = @_; + + $this->charsetTemplates('utf-8') unless $this->charsetTemplates; +} + sub Process { my ($this,$action,$nextHandler) = @_; my $doc = new IMPL::Web::TDocument(); try { - $doc->loadFile ( $ENV{PATH_TRANSLATED}, 'cp1251' ); + $doc->loadFile ( $ENV{PATH_TRANSLATED}, $this->charsetTemplates ); $action->response->contentType('text/html'); my $hOut = $action->response->streamBody;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_doc/make.pl Mon Mar 15 17:45:13 2010 +0300 @@ -0,0 +1,130 @@ +#!/usr/bin/perl -w +use strict; + +use Pod::POM; +use Pod::POM::View::HTML; +use File::Spec; + +our $LibDir = '../Lib/IMPL'; +our $OutDir = 'html'; + +our $index = { name => 'root' }; + +sub process_file { + my ($fname,@path) = @_; + + (my $name = $path[$#path]) =~ s/\.pm$//; + + (my $fileUrl = File::Spec->catfile(@path)) =~ s/\.pm$/.html/i; + + $index->{items}{$name}{name} = $name; + $index->{items}{$name}{url} = $fileUrl; + + (my $fnameOut = File::Spec->catfile($OutDir,@path)) =~ s/\.pm$/.html/i; + + my $dir =$OutDir; + foreach my $part (@path[0..$#path-1]) { + $dir = File::Spec->catdir($dir,$part); + mkdir $dir unless -d $dir; + } + + open my $hPod, "<:encoding(cp1251)", $fname or die "Failed to open $fname for input: $!"; + open my $hOut, ">:encoding(utf-8)", $fnameOut or die "Failed to open $fnameOut for output: $!"; + + my $parser = Pod::POM->new( ); + + my $pom = $parser->parse_file($hPod); + + print $hOut PodViewHTML->print($pom); +} + +sub process_dir { + my ($dirname,@dirs) = @_; + + opendir my $hdir, $dirname or die "faield to open dir $dirname: $!"; + + foreach my $entry (readdir $hdir) { + next if grep $_ eq $entry, '.','..'; + + my $path = "$dirname/$entry"; + + print "$path"; + + if (-d $path) { + print "\n"; + local $index = exists $index->{items}{$entry} ? $index->{items}{$entry} : ($index->{items}{$entry} = {name => $entry}); + process_dir($path,@dirs,$entry); + } elsif ($entry =~ /\.(pm|pod)$/) { + print "\tprocessed\n"; + process_file($path,@dirs,$entry); + } else { + print "\tskipped\n"; + } + } +} + +sub build_index { + my ($hout,$index) = @_; + + print $hout "\n<ul>\n"; + + if ($index->{items}) { + foreach my $itemKey (sort keys %{$index->{items}}) { + my $item = $index->{items}{$itemKey}; + print $hout "<li>"; + print $hout "<a href='$item->{url}'>" if $item->{url}; + print $hout $item->{name}; + print $hout "</a>" if $item->{url}; + build_index($hout,$item) if $item->{items}; + print $hout "</li>\n"; + } + } + + print $hout "</ul>\n"; +} + +`rm -r html`; +mkdir 'html' unless -d 'html'; + +process_dir($LibDir); + +open my $hout, ">:encoding(utf-8)", "$OutDir/index.html" or die "failed to open index.html for output: $!"; + +print $hout <<HEADER; +<html> +<head> +<meta http-equiv="Content-type" content="text/html; charset=UTF-8"/> +<title>IMPL reference</title> +</head> +<body> +HEADER + +build_index($hout,$index); + +print $hout <<FOOTER; +</body> +</html> +FOOTER + +package PodViewHTML; +use base qw(Pod::POM::View::HTML); + +sub view_pod { + my ($self, $pod) = @_; + return "<html>\n<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" /> + \n<body bgcolor=\"#ffffff\">\n" + . $pod->content->present($self) + . "</body>\n</html>\n"; +} +sub view_begin { + my ($self,$begin) = @_; + $begin->format =~ /code/i ? return "<pre>\n".join ("",$begin->text())."</pre>\n" : return $self->SUPER::view_begin($begin); +} + +sub view_seq_link { + my ($self,$text) = @_; + + $text->text =~ /(?:(\w+)\s+)(\w+(?:\:\:\w+)*)/; + + +} \ No newline at end of file