# HG changeset patch
# User wizard
# Date 1268664313 -10800
# Node ID 259cd3df6e53c7ee3ac22ac7d408041c24889ea2
# Parent  76b878ad6596f70f552240dd6b533c2b5287771a
Doc generation
Minor fixes

diff -r 76b878ad6596 -r 259cd3df6e53 .hgignore
--- 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
diff -r 76b878ad6596 -r 259cd3df6e53 Lib/IMPL/DOM/Navigator/Builder.pm
--- 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
 
diff -r 76b878ad6596 -r 259cd3df6e53 Lib/IMPL/Object.pm
--- 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
 
 Базовый класс для объектов, основанных на хеше.
diff -r 76b878ad6596 -r 259cd3df6e53 Lib/IMPL/Object/Factory.pm
--- /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
diff -r 76b878ad6596 -r 259cd3df6e53 Lib/IMPL/Web/QueryHandler/PageFormat.pm
--- 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;
diff -r 76b878ad6596 -r 259cd3df6e53 _doc/make.pl
--- /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