@@ -11,7 +11,8 @@ Module::Build->new
'FCGI'=>0.67,
'Test::Class'=>0,
'URI'=>1.36,
- 'HTTP::Body'=>1.11
+ 'HTTP::Body'=>1.11,
+ 'MIME::Base64' =>0
},
script_files=>[qw!
script/wd_fcgi.fpl
@@ -1,5 +1,15 @@
Revision history for Perl extension WebDAO.
+2.16 20 Nov 2014
+ * add -u opt (set auth headers) for wd_shell.pl
+
+2.15 16 Nov 2014
+ * remove session attributes
+ * fix wdSessionPar under PSGI
+ * fix wrn if empty HTTP body
+ * fix defined(@array) is deprecated
+ * add -c /config.ini alias for -wdEnginePar config=[/config.ini] (wd_shell.pl)
+
2.14 03 Oct 2012
* add -d opt to wd_shell.pl
2.12 26 Sep 2012
@@ -1,3 +1,4 @@
+.gitignore
Build.PL
Changes
contrib/About.pod
@@ -35,8 +36,6 @@ lib/WebDAO/Response.pm
lib/WebDAO/Session.pm
lib/WebDAO/Sessionco.pm
lib/WebDAO/SessionSH.pm
-lib/WebDAO/Store/Abstract.pm
-lib/WebDAO/Store/Storable.pm
lib/WebDAO/Test.pm
lib/WebDAO/Util.pm
Makefile.PL
@@ -47,8 +46,6 @@ script/wd_shell.pl
script/webdao.psgi
t/02_response.t
t/04.Config.t
-t/1.t
-t/11.t
t/13_extra_path.t
t/14_test_any_method.t
t/15.lex.t
@@ -66,3 +63,5 @@ t/lib/TestLoad.pm
t/lib/TestWDAO.pm
t/test_util.t
t/tests.t
+META.yml
+META.json
@@ -0,0 +1,162 @@
+{
+ "abstract" : "platform for easy creation of high-performance and scalable web applications",
+ "author" : [
+ "Zahatski Aliaksandr, E<lt>zag@cpan.orgE<gt>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "WebDAO",
+ "prereqs" : {
+ "configure" : {
+ "requires" : {
+ "Module::Build" : "0.40"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "DateTime" : "0.37",
+ "DateTime::Format::HTTP" : "0.37",
+ "Encode" : "0",
+ "FCGI" : "0.67",
+ "Getopt::Long" : "2.35",
+ "HTTP::Body" : "1.11",
+ "MIME::Base64" : "0",
+ "Test::Class" : "0",
+ "URI" : "1.36",
+ "XML::Flow" : "0.86"
+ }
+ }
+ },
+ "provides" : {
+ "Test::Writer" : {
+ "file" : "lib/WebDAO/Test.pm",
+ "version" : 0
+ },
+ "TestCV" : {
+ "file" : "lib/WebDAO/Test.pm",
+ "version" : 0
+ },
+ "WebDAO" : {
+ "file" : "lib/WebDAO.pm",
+ "version" : "2.16"
+ },
+ "WebDAO::Base" : {
+ "file" : "lib/WebDAO/Base.pm",
+ "version" : 0
+ },
+ "WebDAO::CV" : {
+ "file" : "lib/WebDAO/CV.pm",
+ "version" : 0
+ },
+ "WebDAO::CVfcgi" : {
+ "file" : "lib/WebDAO/CVfcgi.pm",
+ "version" : 0
+ },
+ "WebDAO::CVfcgiold" : {
+ "file" : "lib/WebDAO/CVfcgi.pm",
+ "version" : 0
+ },
+ "WebDAO::Component" : {
+ "file" : "lib/WebDAO/Component.pm",
+ "version" : 0
+ },
+ "WebDAO::Config" : {
+ "file" : "lib/WebDAO/Config.pm",
+ "version" : "0.3"
+ },
+ "WebDAO::Container" : {
+ "file" : "lib/WebDAO/Container.pm",
+ "version" : 0
+ },
+ "WebDAO::Element" : {
+ "file" : "lib/WebDAO/Element.pm",
+ "version" : 0
+ },
+ "WebDAO::Engine" : {
+ "file" : "lib/WebDAO/Engine.pm",
+ "version" : 0
+ },
+ "WebDAO::FCGI::ProcManager" : {
+ "file" : "lib/WebDAO/FCGI/ProcManager.pm",
+ "version" : "0.17"
+ },
+ "WebDAO::Fcgi::Writer" : {
+ "file" : "lib/WebDAO/CVfcgi.pm",
+ "version" : 0
+ },
+ "WebDAO::Lex" : {
+ "file" : "lib/WebDAO/Lex.pm",
+ "version" : 0
+ },
+ "WebDAO::Lexer::base" : {
+ "file" : "lib/WebDAO/Lexer/base.pm",
+ "version" : 0
+ },
+ "WebDAO::Lexer::method" : {
+ "file" : "lib/WebDAO/Lexer/method.pm",
+ "version" : 0
+ },
+ "WebDAO::Lexer::object" : {
+ "file" : "lib/WebDAO/Lexer/object.pm",
+ "version" : 0
+ },
+ "WebDAO::Lexer::regclass" : {
+ "file" : "lib/WebDAO/Lexer/regclass.pm",
+ "version" : 0
+ },
+ "WebDAO::Lexer::text" : {
+ "file" : "lib/WebDAO/Lexer/text.pm",
+ "version" : 0
+ },
+ "WebDAO::Lib::MethodByPath" : {
+ "file" : "lib/WebDAO/Lib/MethodByPath.pm",
+ "version" : 0
+ },
+ "WebDAO::Lib::RawHTML" : {
+ "file" : "lib/WebDAO/Lib/RawHTML.pm",
+ "version" : 0
+ },
+ "WebDAO::Modal" : {
+ "file" : "lib/WebDAO/Modal.pm",
+ "version" : 0
+ },
+ "WebDAO::Response" : {
+ "file" : "lib/WebDAO/Response.pm",
+ "version" : 0
+ },
+ "WebDAO::Session" : {
+ "file" : "lib/WebDAO/Session.pm",
+ "version" : 0
+ },
+ "WebDAO::SessionSH" : {
+ "file" : "lib/WebDAO/SessionSH.pm",
+ "version" : 0
+ },
+ "WebDAO::Sessionco" : {
+ "file" : "lib/WebDAO/Sessionco.pm",
+ "version" : 0
+ },
+ "WebDAO::Test" : {
+ "file" : "lib/WebDAO/Test.pm",
+ "version" : 0
+ },
+ "WebDAO::Util" : {
+ "file" : "lib/WebDAO/Util.pm",
+ "version" : 0
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "license" : [
+ "http://dev.perl.org/licenses/"
+ ]
+ },
+ "version" : "2.16"
+}
@@ -0,0 +1,116 @@
+---
+abstract: 'platform for easy creation of high-performance and scalable web applications'
+author:
+ - 'Zahatski Aliaksandr, E<lt>zag@cpan.orgE<gt>'
+build_requires: {}
+configure_requires:
+ Module::Build: 0.40
+dynamic_config: 1
+generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: WebDAO
+provides:
+ Test::Writer:
+ file: lib/WebDAO/Test.pm
+ version: 0
+ TestCV:
+ file: lib/WebDAO/Test.pm
+ version: 0
+ WebDAO:
+ file: lib/WebDAO.pm
+ version: 2.16
+ WebDAO::Base:
+ file: lib/WebDAO/Base.pm
+ version: 0
+ WebDAO::CV:
+ file: lib/WebDAO/CV.pm
+ version: 0
+ WebDAO::CVfcgi:
+ file: lib/WebDAO/CVfcgi.pm
+ version: 0
+ WebDAO::CVfcgiold:
+ file: lib/WebDAO/CVfcgi.pm
+ version: 0
+ WebDAO::Component:
+ file: lib/WebDAO/Component.pm
+ version: 0
+ WebDAO::Config:
+ file: lib/WebDAO/Config.pm
+ version: 0.3
+ WebDAO::Container:
+ file: lib/WebDAO/Container.pm
+ version: 0
+ WebDAO::Element:
+ file: lib/WebDAO/Element.pm
+ version: 0
+ WebDAO::Engine:
+ file: lib/WebDAO/Engine.pm
+ version: 0
+ WebDAO::FCGI::ProcManager:
+ file: lib/WebDAO/FCGI/ProcManager.pm
+ version: 0.17
+ WebDAO::Fcgi::Writer:
+ file: lib/WebDAO/CVfcgi.pm
+ version: 0
+ WebDAO::Lex:
+ file: lib/WebDAO/Lex.pm
+ version: 0
+ WebDAO::Lexer::base:
+ file: lib/WebDAO/Lexer/base.pm
+ version: 0
+ WebDAO::Lexer::method:
+ file: lib/WebDAO/Lexer/method.pm
+ version: 0
+ WebDAO::Lexer::object:
+ file: lib/WebDAO/Lexer/object.pm
+ version: 0
+ WebDAO::Lexer::regclass:
+ file: lib/WebDAO/Lexer/regclass.pm
+ version: 0
+ WebDAO::Lexer::text:
+ file: lib/WebDAO/Lexer/text.pm
+ version: 0
+ WebDAO::Lib::MethodByPath:
+ file: lib/WebDAO/Lib/MethodByPath.pm
+ version: 0
+ WebDAO::Lib::RawHTML:
+ file: lib/WebDAO/Lib/RawHTML.pm
+ version: 0
+ WebDAO::Modal:
+ file: lib/WebDAO/Modal.pm
+ version: 0
+ WebDAO::Response:
+ file: lib/WebDAO/Response.pm
+ version: 0
+ WebDAO::Session:
+ file: lib/WebDAO/Session.pm
+ version: 0
+ WebDAO::SessionSH:
+ file: lib/WebDAO/SessionSH.pm
+ version: 0
+ WebDAO::Sessionco:
+ file: lib/WebDAO/Sessionco.pm
+ version: 0
+ WebDAO::Test:
+ file: lib/WebDAO/Test.pm
+ version: 0
+ WebDAO::Util:
+ file: lib/WebDAO/Util.pm
+ version: 0
+requires:
+ DateTime: 0.37
+ DateTime::Format::HTTP: 0.37
+ Encode: 0
+ FCGI: 0.67
+ Getopt::Long: 2.35
+ HTTP::Body: 1.11
+ MIME::Base64: 0
+ Test::Class: 0
+ URI: 1.36
+ XML::Flow: 0.86
+resources:
+ license: http://dev.perl.org/licenses/
+version: 2.16
@@ -1,4 +1,4 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.40
+# Note: this file was auto-generated by Module::Build::Compat version 0.4003
use ExtUtils::MakeMaker;
WriteMakefile
(
@@ -11,6 +11,7 @@ WriteMakefile
'FCGI' => '0.67',
'Getopt::Long' => '2.35',
'HTTP::Body' => '1.11',
+ 'MIME::Base64' => 0,
'Test::Class' => 0,
'URI' => '1.36',
'XML::Flow' => '0.86'
@@ -42,7 +42,7 @@ http://webdao.sourceforge.net
COPYRIGHT AND LICENCE
-Copyright (C) 2002-2009 Zahatski Aliaksandr
+Copyright (C) 2002-2014 Zahatski Aliaksandr
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
@@ -19,7 +19,7 @@ B<WebDAO> - object-oriented system for easy creation of high-performance and sc
There are many environments in which the web applications work:
---------------------------------------------
- | mod_perl Apache |
+ | Apache |
| FastCGI CGI |
| ------------------------ |
| nginx | | |
@@ -92,61 +92,4 @@ Equivalent to the following:
http:://example.com/test/index_x
-=head3 Built-in support session parameters
-
-
-In I<WebDAO> built-in support sessional settings. Schematically, it can provide the following diagrams:
-
-
- +-----------------+ load +------------------+ Storages:
- | | <---------- | | -> MLDBM files
- | Session object | store | WebDAO::Store::* | -> Storable files
- | | ----------> | | -> MemCached,MemCacheDB
- +-----------------+ +------------------+ -> Custom storage ...
- ^ |
- /|\ |
- | |
- | \|/
- | V
- +-----------------+
- | |
- | WebDAO::Engine |
- | |
- +-----------------+
-
-
-To do this, simply select the source storage in the configuration web server, and specify the attributes in the inherited class.
-
-Example configuration (I<Apache> web server):
-
- <VirtualHost *>
- ...
- #set Storable storage
- SetEnv wdStore WebDAO::Store::Storable
- #path for store
- SetEnv wdStorePar path=/tmp/sessions
-
- #Track session via cookies
- SetEnv wdSession WebDAO::Sessionco
- ...
- </VirtualHost>
-
-The text of the module also need to create attributes:
-
- package MySess;
- use WebDAO::Component;
- use base 'WebDAO::Component';
-
- # define list of session attributes
-
- __PACKAGE__->mk_sess_attr( attr1 => undef, _attr2 => undef );
-
- sub UseAttr {
- my $self = shift;
- # read
- my $val = $self->attr1;
- ...
- $self->attr1('test_value');
- }
-
=end pod
@@ -11,14 +11,12 @@ B<WebDAO> - объектно-ориентированная система дл
=item * Адресация объектов по URL
-=item * Встроенная поддержка сессионных параметров
-
=head3 Абстракция среды выполнения кода приложения
Существует большое количество окружений, в которых работают web приложений.
---------------------------------------------
- | mod_perl Apache |
+ | Apache |
| FastCGI CGI |
| ------------------------ |
| nginx | | |
@@ -91,60 +89,5 @@ B<WebDAO> проектировалась с целью избавить раз
http:://example.com/test/index_x
-=head3 Встроенная поддержка сессионных параметров
-
-В I<WebDAO> встроена поддержка сессионных параметров. Схематически ее можно представить следующей диаграммой объектов:
-
- +-----------------+ load +------------------+ Storages:
- | | <---------- | | -> MLDBM files
- | Session object | store | WebDAO::Store::* | -> Storable files
- | | ----------> | | -> MemCached,MemCacheDB
- +-----------------+ +------------------+ -> Custom storage ...
- ^ |
- /|\ |
- | |
- | \|/
- | V
- +-----------------+
- | |
- | WebDAO::Engine |
- | |
- +-----------------+
-
-Для этого достаточно выбрать источник хранения в конфигурации web сервера и указать атрибуты объекта в наследуемом классе.
-
-Пример конфигурации (I<Apache> web server):
-
- <VirtualHost *>
- ...
- #set Storable storage
- SetEnv wdStore WebDAO::Store::Storable
- #path for store
- SetEnv wdStorePar path=/tmp/sessions
-
- #Track session via cookies
- SetEnv wdSession WebDAO::Sessionco
- ...
- </VirtualHost>
-
-
-В тексте модуля также необходимо создать атрибуты:
-
- package MySess;
- use WebDAO::Component;
- use base 'WebDAO::Component';
-
- # Определение сессионных атрибутов и
- # их значений по умалчанию
-
- __PACKAGE__->mk_sess_attr( attr1 => undef, _attr2 => undef );
-
- sub UseAttr {
- my $self = shift;
- # read
- my $val = $self->attr1;
- ...
- $self->attr1('test_value');
- }
=end pod
@@ -11,8 +11,6 @@ wdIndexFile |" index.html - name of the file to be processed upon request. Possi
wdEngine |" name of the package core module. This module serves all requests coming to I</>. Default: I<WebDAO::Engine> "| ShowPrice
wdEnginePar |" initialization parameters when creating the main module. Value a string containing the pairs I<key=value>. Pairs are semicolon separated (I<;>). Default: I<undef> "| config=/home/zag/showprice.ini
wdSession | Name the package module, which serves a sessional. This module is used to identify a web session. Default: I<WebDAO::Session> | WebDAO::Sessionco
-wdStore |" the name of the module, providing storage of a user session parameters. Defalut: I<WebDAO::Store::Abstract>"| WebDAO::Store::Storable
-wdStorePar | initialization parameters for session storage module. default: I<undef> | path=/home/zag/tmp
wdFCGIreq | number of requests for each I<FastCGI> process. The parameter is used to work in I<FastCGI> mode. Default: -1 - unlimited | 1000
wdDebug |" Debug level. 1 - critical errors, 2 .. n - warns, info. Default: 0 - off "| 2
@@ -159,10 +157,6 @@ At B<VirtualHost> section:
SetEnv wdIndexFile index.xhtml
SetEnv wdSession WebDAO::Sessionco
- #for use external storage
- #SetEnv wdStore WebDAO::Store::MLDBM
- #SetEnv wdStorePar path=/tmp
-
RewriteEngine on
AddDefaultCharset UTF-8
RewriteCond %{HTTP:Authorization} ^(.*)$ [NC]
@@ -12,8 +12,6 @@ wdIndexFile |" index.html - наименование файла, который
wdEngine | наименование пакета основного модуля. Этот модуль обслуживает все запросы поступающие к I</>. По умолчанию: I<WebDAO::Engine> | ShowPrice
wdEnginePar |" параметры инициализации при создании основного модуля. Значение - строка, содержащая пары I<ключ=значние>. Пары отделяются друг от друга I<;>. По умолчанию: I<undef> "| config=/home/zag/showprice.ini
wdSession |" имя пакета модуля, обслуживающего сессионность. Этот модуль используется для идентификации web сессии. По умолчанию: I<WebDAO::Session> "| WebDAO::Sessionco
-wdStore |" имя модуля, обеспечивающего хранение сессионных параметров пользователя. По умолчанию: I<WebDAO::Store::Abstract>"| WebDAO::Store::MLDBM
-wdStorePar| параметры инициализации для модуля хранения сессионных параметров. По умолчанию: I<undef>| path=/home/zag/Work/Recomendator/bin/tmp
wdFCGIreq | количество запросов на I<FastCGI> процесс. Параметр используется при работе в режиме I<FastCGi>. По умолчанию: -1 - unlimited | 1000
wdDebug |" уровень отладки. 1 - критические ошибки, 2 .. n - warns, info. По умолчанию: 0 - отключен "| 2
@@ -158,10 +156,6 @@ Web root | /usr/zag/www
SetEnv wdIndexFile index.xhtml
SetEnv wdSession WebDAO::Sessionco
- #for use external storage
- #SetEnv wdStore WebDAO::Store::MLDBM
- #SetEnv wdStorePar path=/tmp
-
RewriteEngine on
AddDefaultCharset UTF-8
RewriteCond %{HTTP:Authorization} ^(.*)$ [NC]
@@ -1,5 +1,4 @@
package WebDAO::Base;
-#$Id$
=head1 NAME
@@ -16,52 +15,10 @@ WebDAO::Base - Base class
use Data::Dumper;
use Carp;
@WebDAO::Base::ISA = qw(Exporter);
-@WebDAO::Base::EXPORT = qw(attributes sess_attributes);
+@WebDAO::Base::EXPORT = qw(mk_attr);
$DEBUG = 0; # assign 1 to it to see code generated on the fly
-sub mk_sess_attr {
- my ($pkg) = caller;
- shift if $_[0] =~ /\:\:/ or $_[0] eq $pkg;
-# croak "Error: attributes() invoked multiple times"
-# if scalar @{"${pkg}::_SESS_ATTRIBUTES_"};
- my %attrs = @_;
- %{"${pkg}::_SESS_ATTRIBUTES_"} = %attrs;
- my $code = "";
- foreach my $attr (keys %attrs) {
- # If the accessor is already present, give a warning
- if ( UNIVERSAL::can( $pkg, "$attr" ) ) {
- carp "$pkg already has method: $attr";
- next;
- }
- $code .= _define_sess_accessor( $pkg, $attr, $attrs{$attr} );
- }
- eval $code;
- if ($@) {
- die "ERROR defining and attributes for '$pkg':"
- . "\n\t$@\n"
- . "-----------------------------------------------------"
- . $code;
- }
-}
-
-
-sub _define_sess_accessor {
- my ( $pkg, $attr, $default ) = @_;
-
- # qq makes this block behave like a double-quoted string
- my $code = qq{
- package $pkg;
- sub $attr { # Accessor ...
- my \$self=shift;
- my \$ret = \@_ ? \$self->set_attribute("$attr",shift):\$self->get_attribute("$attr");
- return \${"${pkg}::_SESS_ATTRIBUTES_"}{"$attr"} unless defined \$ret;
- \$ret
- }
- };
- $code;
-}
-
sub mk_attr {
my ($pkg) = caller;
shift if $_[0] =~ /\:\:/ or $_[0] eq $pkg;
@@ -105,69 +62,6 @@ sub _define_attr_accessor {
$code;
}
-sub sess_attributes {
- my ($pkg) = caller;
- shift if $_[0] =~ /\:\:/ or $_[0] eq $pkg;
- croak "Error: attributes() invoked multiple times"
- if scalar @{"${pkg}::_SESS_ATTRIBUTES_"};
- my %attrs = map { $_=>undef} @_;
- %{"${pkg}::_SESS_ATTRIBUTES_"} = %attrs;
- my $code = "";
- foreach my $attr (@_) {
- # If the accessor is already present, give a warning
- if ( UNIVERSAL::can( $pkg, "$attr" ) ) {
- carp "$pkg already has method: $attr";
- next;
- }
- $code .= _define_accessor( $pkg, $attr );
- }
- eval $code;
- if ($@) {
- die "ERROR defining and attributes for '$pkg':"
- . "\n\t$@\n"
- . "-----------------------------------------------------"
- . $code;
- }
-}
-
-sub attributes {
- my ($pkg) = caller;
- shift if $_[0] =~ /\:\:/ or $_[0] eq $pkg;
- my $code = "";
- foreach my $attr (@_) {
- print STDERR " defining method $attr\n" if $DEBUG;
-
- # If the accessor is already present, give a warning
- if ( UNIVERSAL::can( $pkg, "$attr" ) ) {
- carp "$pkg already has rtl method: $attr";
- next;
- }
- $code .= _define_accessor( $pkg, $attr );
- }
- eval $code;
- if ($@) {
- die "ERROR defining rtl_attributes for '$pkg':"
- . "\n\t$@\n"
- . "-----------------------------------------------------"
- . $code;
- }
-
-}
-
-sub _define_accessor {
- my ( $pkg, $attr ) = @_;
-
- # qq makes this block behave like a double-quoted string
- my $code = qq{
- package $pkg;
- sub $attr { # Accessor ...
- my \$self=shift;
- \@_ ? \$self->set_attribute("$attr",shift):\$self->get_attribute("$attr");
- }
- };
- $code;
-}
-
sub _define_constructor {
my $pkg = shift;
my $code = qq {
@@ -185,58 +79,6 @@ sub _define_constructor {
$code;
}
-sub get_attribute_names {
- my $pkg = shift;
- $pkg = ref($pkg) if ref($pkg);
- my @result = keys %{"${pkg}::_SESS_ATTRIBUTES_"};
- if ( defined( @{"${pkg}::ISA"} ) ) {
- foreach my $base_pkg ( @{"${pkg}::ISA"} ) {
- push( @result, get_attribute_names($base_pkg) );
- }
- }
- @result;
-}
-
-sub set_attribute {
- my ( $obj, $attr_name, $attr_value ) = @_;
- $obj->{"Var"}->{$attr_name} = $attr_value;
-}
-
-#
-sub get_attribute {
- my ( $self, $attr_name ) = @_;
- return $self->{"Var"}->{$attr_name};
-}
-
-# $obj->set_attributes (name => 'John', age => 23);
-# Or, $obj->set_attributes (['name', 'age'], ['John', 23]);
-sub set_attributes {
- my $obj = shift;
- my $attr_name;
- if ( ref( $_[0] ) ) {
- my ( $attr_name_list, $attr_value_list ) = @_;
- my $i = 0;
- foreach $attr_name (@$attr_name_list) {
- $obj->$attr_name( $attr_value_list->[ $i++ ] );
- }
- }
- else {
- my ( $attr_name, $attr_value );
- while (@_) {
- $attr_name = shift;
- $attr_value = shift;
- $obj->$attr_name($attr_value);
- }
- }
-}
-
-# @attrs = $obj->get_attributes (qw(name age));
-sub get_attributes {
- my $obj = shift;
- my (@retval);
- map { $obj->$_() } @_;
-}
-
sub new {
my $class = shift;
my $self = {};
@@ -303,7 +145,7 @@ Zahatski Aliaksandr, E<lt>zag@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
-Copyright 2002-2009 by Zahatski Aliaksandr
+Copyright 2002-2014 by Zahatski Aliaksandr
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
@@ -203,8 +203,9 @@ sub get_body {
my $body;
{
local $/;
- my $fd = $self->body;
- $body = <$fd>;
+ if ( my $fd = $self->body ) {
+ $body = <$fd>
+ }
}
return $body
}
@@ -1,5 +1,4 @@
package WebDAO::Component;
-#$Id$
=head1 NAME
@@ -34,7 +33,7 @@ Zahatski Aliaksandr, E<lt>zag@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
-Copyright 2002-2012 by Zahatski Aliaksandr
+Copyright 2002-2014 by Zahatski Aliaksandr
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
@@ -32,19 +32,6 @@ sub _sysinit {
$self->_clear_childs_();
}
-sub _get_vars {
- my $self = shift;
- my ( $res, $ref );
- $res = $self->SUPER::_get_vars;
- return $res;
-}
-
-sub _set_vars {
- my ( $self, $ref ) = @_;
- my $chld_name;
- $self->SUPER::_set_vars($ref);
-}
-
=head1 METHODS (chidls)
=head2 _get_childs_()
@@ -123,7 +110,6 @@ sub __add_childs__ {
return unless @childs;
if ( $self->__parent ) {
$_->_set_parent($self) for @childs;
- $self->_root_->__restore_session_attributes(@childs);
}
push( @{$dst}, @childs );
}
@@ -78,7 +78,6 @@ sub _sysinit {
#init hash of attribute_names
my $ref_names_hash = {};
- map { $ref_names_hash->{$_} = 1 } $self->get_attribute_names();
$self->__attribute_names($ref_names_hash);
@@ -89,17 +88,6 @@ sub init {
#Public Init metod for modules;
}
-sub _get_vars {
- my $self = shift;
- my $res;
- for my $key ( keys %{ $self->__attribute_names } ) {
- my $val = $self->get_attribute($key);
- no strict 'vars';
- $res->{$key} = $val if ( defined($val) );
- use strict 'vars';
- }
- return $res;
-}
=head2 _get_childs_()
@@ -225,21 +213,6 @@ sub _destroy {
$self->__engine(undef);
}
-sub _set_vars {
- my ( $self, $ref, $names ) = @_;
- $names = $self->__attribute_names;
- for my $key ( keys %{$ref} ) {
- if ( exists( $names->{$key} ) ) {
- $self ->${key}( $ref->{$key} );
- }
- else {
-
- # Uknown attribute ???
-
- }
- }
-}
-
sub url_method {
my $self = shift;
my $method = shift;
@@ -24,7 +24,7 @@ sub _sysinit {
my %hash = @$ref;
# Setup $init_hash;
- my $my_name = $hash{id} || ''; #shift( @{$ref} );
+ my $my_name = $hash{id} || '';
unshift(
@{$ref},
{
@@ -76,40 +76,6 @@ sub init {
}
-sub __restore_session_attributes {
- my $self = shift;
-
- #collect paths as index
- my %paths;
- foreach my $object (@_) {
- my @collection = ( $object, @{ $object->_get_childs_ } );
- $paths{ $_->__path2me } = $_ for @collection;
- }
- my $sess = $self->_session;
- my $loaded = $sess->_load_attributes_by_path( keys %paths );
- while ( my ( $key, $ref ) = each %$loaded ) {
- next unless exists $paths{$key};
- $paths{$key}->_set_vars($ref);
- }
-}
-
-sub __store_session_attributes {
- my $self = shift;
-
- #collect paths as index
- my %paths;
- foreach my $object (@_) {
- my @collection = ( $object, @{ $object->_get_childs_ } );
- foreach (@collection) {
- my $attrs = $_->_get_vars;
- next unless $attrs;
- $paths{ $_->__path2me } = $attrs;
- }
- }
- my $sess = $self->_session;
- $sess->_store_attributes_by_path( \%paths );
-}
-
sub response {
my $self = shift;
return $self->_session->response_obj;
@@ -412,7 +378,6 @@ sub register_class {
sub _destroy {
my $self = shift;
- $self->__store_session_attributes( @{ $self->_get_childs_ } );
$self->SUPER::_destroy;
$self->_session(undef);
$self->__obj(undef);
@@ -15,11 +15,13 @@ WebDAO::Lib::RawHTML - Component for raw html
use WebDAO::Base;
use base qw(WebDAO::Component);
-attributes (_raw_html);
+__PACKAGE__->mk_attr(_raw_html=>undef);
+
sub init {
my ($self,$ref_raw_html)=@_;
_raw_html $self $ref_raw_html;
}
+
sub fetch {
my $self=shift;
return ${$self->_raw_html};
@@ -38,7 +40,7 @@ Zahatski Aliaksandr, E<lt>zag@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
-Copyright 2002-2009 by Zahatski Aliaksandr
+Copyright 2002-2014 by Zahatski Aliaksandr
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
@@ -14,7 +14,6 @@ Session interface to device(HTTP protocol) specific function
use WebDAO::Base;
use WebDAO::CV;
-use WebDAO::Store::Abstract;
use WebDAO::Response;
use Data::Dumper;
use base qw( WebDAO::Base );
@@ -26,7 +25,6 @@ __PACKAGE__->mk_attr(
Cgi_env => undef,
U_id=> undef,
Params => undef,
- _store_obj =>undef,
_response_obj=> undef, #deprecated ?
_is_absolute_url =>undef #deprecated ?
);
@@ -57,7 +55,6 @@ sub Init {
new WebDAO::Response::
cv => $cv
);
- _store_obj $self ( $args{store} || new WebDAO::Store::Abstract:: );
Cgi_env $self (
{
@@ -132,21 +129,6 @@ sub set_absolute_url {
return $prev_value;
}
-sub _load_attributes_by_path {
- my $self = shift;
- $self->_store_obj->_load_attributes( $self->get_id(), @_ );
-}
-
-sub _store_attributes_by_path {
- my $self = shift;
- $self->_store_obj->_store_attributes( $self->get_id(), @_ );
-}
-
-sub flush_session {
- my $self = shift;
- $self->_store_obj->flush( $self->get_id() );
-}
-
sub get_request {
my $self = shift;
return $self->Cgi_obj;
@@ -170,7 +152,6 @@ sub ExecEngine {
$eng_ref->execute($self, $path);
$eng_ref->__send_event__("_sess_ended");
$eng_ref->_destroy;
- $self->flush_session();
}
sub destroy {
@@ -23,7 +23,6 @@ sub Init {
my $self = shift;
my %args = @_;
$self->SUPER::Init(@_);
- delete $args{store};
delete $args{cv};
$self->U_id( rand(100) );
#setup default method
@@ -48,7 +47,7 @@ Zahatski Aliaksandr, E<lt>zag@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
-Copyright 2002-2010 by Zahatski Aliaksandr
+Copyright 2002-2014 by Zahatski Aliaksandr
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
@@ -1,42 +0,0 @@
-package WebDAO::Store::Abstract;
-
-#$Id$
-
-=head1 NAME
-
-WebDAO::Store::Abstract - Abstract session store
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-WebDAO::Store::Abstract - Abstract session store
-
-=cut
-
-
-use WebDAO::Base;
-use Data::Dumper;
-use strict;
-@WebDAO::Store::Abstract::ISA = ('WebDAO::Base');
-sub _init {
- my $self = shift;
- return $self->init(@_);
-}
-sub init {
- return 1
-}
-sub load { {} }
-sub store { {} }
-sub _load_attributes {
- my $self = shift;
- return {}
-}
-sub _store_attributes {
- my $self = shift;
- return {}
-}
-sub flush { #$_[0]->_log1("flush")
-}
-
-1;
@@ -1,98 +0,0 @@
-package WebDAO::Store::Storable;
-
-#$Id$
-
-=head1 NAME
-
-WebDAO::Store::Storable - Implement session store using Storable
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-WebDAO::Store::Storable - Implement session store using Storable
-
-=cut
-
-
-use Storable qw(lock_nstore lock_retrieve);
-use WebDAO::Store::Abstract;
-use strict 'vars';
-use base 'WebDAO::Store::Abstract';
-
-__PACKAGE__->mk_attr ( _dir=>undef, _cache=>undef, _is_loaded=>undef);
-
-sub init {
- my $self = shift;
- my %pars = @_;
- die "need param path to dir" unless exists $pars{path};
- my $dir = $pars{path};
- $dir .= "/" unless $dir =~ m%/$%;
- unless ( -d $dir ) {
- eval {
- mkpath( $dir, 0 );
- };
- if ($@) {
- _log1 $self "error mkdir".$@
- }
-
- }
- $self->_dir($dir);
- my %hash;
- $self->_cache( \%hash );
- return 1;
-}
-
-sub load {
- my $self =shift;
- my $id = shift || return {};
- my $db_file = $self->_dir()."sess_$id.sdb";
- return {} unless -e $db_file;
- return lock_retrieve($db_file);
-}
-
-sub store {
- my $self =shift;
- my $id = shift || return {};
- my $ref_tree = shift;
- return unless $ref_tree && ref($ref_tree);
- my $db_file = $self->_dir()."sess_$id.sdb";
- lock_nstore($ref_tree,$db_file);
- return $id;
-}
-sub _store_attributes {
- my $self = shift;
- my $id = shift || return;
- my $ref = shift || return;
- my $cache = $self->_cache();
- while ( my ( $key, $val ) = each %$ref ) {
- $cache->{$key} = $val;
- }
-}
-
-sub _load_attributes {
- my $self = shift;
- my $id = shift || return;
- unless ( $self->_is_loaded ) {
- my $from_storage = $self->load($id);
- my $cache = $self->_cache;
- while ( my ( $key, $val ) = each %$from_storage ) {
- next if exists $cache->{$key};
- $cache->{$key} = $val;
- }
- $self->_is_loaded(1);
- }
- my $loaded = $self->_cache;
- my %res;
- foreach my $key (@_) {
- $res{$key} = $loaded->{$key} if exists $loaded->{$key};
- }
- return \%res;
-}
-
-sub flush {
- my $self = shift;
- $self->store( @_, $self->_cache );
-}
-
-1;
@@ -4,14 +4,12 @@
#
# AUTHOR: Aliaksandr P. Zahatski, <zahatski@gmail.com>
#===============================================================================
-#$Id$
package WebDAO::Util;
use strict;
use warnings;
use Carp;
use WebDAO::Engine;
use WebDAO::Session;
-use WebDAO::Store::Abstract;
=head2 load_module <package>
@@ -84,8 +82,6 @@ sub get_classes {
my %defaults = (
wdEngine => 'WebDAO::Engine',
wdSession => 'WebDAO::Session',
- wdStore => 'WebDAO::Store::Abstract',
- wdStorePar => undef,
wdSessionPar => undef,
wdEnginePar => undef,
@_
@@ -93,10 +89,6 @@ sub get_classes {
my $env = delete $defaults{__env} || \%ENV;
my $need_preload = delete $defaults{__preload} || 0;
- $defaults{wdStore} =
- $env->{WD_STORE}
- || $env->{wdStore}
- || $defaults{wdStore};
$defaults{wdSession} =
$env->{WD_SESSION}
|| $env->{wdSession}
@@ -111,17 +103,13 @@ sub get_classes {
WebDAO::Util::_parse_str_to_hash( $env->{WD_ENGINE_PAR}
|| $env->{wdEnginePar} )
|| {};
- $defaults{wdStorePar} =
- WebDAO::Util::_parse_str_to_hash( $env->{WD_STORE_PAR}
- || $env->{wdStorePar} )
- || {};
$defaults{wdSessionPar} =
WebDAO::Util::_parse_str_to_hash( $env->{WD_SESSION_PAR}
|| $env->{wdSessionPar} )
|| {};
if ($need_preload) {
- for (qw/wdStore wdSession wdEngine /) {
+ for (qw/wdSession wdEngine /) {
WebDAO::Util::load_module( $defaults{$_} );
}
}
@@ -14,7 +14,7 @@ use WebDAO::Sessionco;
use WebDAO::Lib::RawHTML;
our @ISA = qw();
-our $VERSION = '2.14';
+our $VERSION = '2.16';
@@ -125,15 +125,11 @@ while ( $count_req != 0 and ($request->Accept() >= 0) ) {
my $ini = WebDAO::Util::get_classes(__env => \%ENV, __preload=>1);
- my $store_obj = "$ini->{wdStore}"->new(
- %{ $ini->{wdStorePar} }
- );
my $cv = $fcgi_controller->new(env=>\%ENV);
my $sess = "$ini->{wdSession}"->new(
%{ $ini->{wdSessionPar} },
- store => $store_obj,
cv => $cv,
);
@@ -6,7 +6,6 @@
# DESCRIPTION: shell script for WebDAO project
# AUTHOR: Aliaksandr P. Zahatski (Mn), <zag@cpan.org>
#===============================================================================
-#$Id: wd_shell.pl,v 1.2 2006/10/27 08:59:08 zag Exp $
package WebDAO::Shell::Writer;
sub new {
@@ -23,23 +22,27 @@ use warnings;
use Carp;
use WebDAO;
use WebDAO::SessionSH;
-use WebDAO::Store::Abstract;
use WebDAO::CV;
use Data::Dumper;
use WebDAO::Lex;
use Getopt::Long;
use Pod::Usage;
use WebDAO::Util;
+use MIME::Base64;
my ( $help, $man, $sess_id, $dump_headers );
-my %opt = ( help => \$help, man => \$man, sid => \$sess_id, d=>\$dump_headers);
+my %opt = ( help => \$help, man => \$man, sid => \$sess_id, d=>\$dump_headers );
my @urls = ();
-GetOptions( \%opt, 'help|?', 'man', 'd', 'f=s', 'wdEngine|M=s', 'wdEnginePar=s',
+GetOptions( \%opt, 'help|?', 'man', 'd', 'f=s', 'wdEngine|M=s', 'wdEnginePar=s', 'c=s', 'u=s',
'sid|s=s', '<>' => sub { push @urls, shift } )
or pod2usage(2);
pod2usage(1) if $help;
pod2usage( -exitstatus => 0, -verbose => 2 ) if $man;
+if ($opt{u}) {
+ $ENV{"HTTP_AUTHORIZATION"} =
+ " " . encode_base64($opt{u});
+}
my $evl_file = shift @urls;
pod2usage( -exitstatus => 2, -message => 'No path give or non exists ' )
unless $evl_file;
@@ -58,12 +61,15 @@ foreach my $sname ('__DIE__') {
$ENV{wdEngine} ||= $opt{wdEngine} || 'WebDAO::Engine';
$ENV{wdEnginePar} ||= $opt{wdEnginePar};
+#overwrite wdEnginePar with config=...
+if ( $opt{c} ) {
+ $ENV{wdEnginePar}='config='.$opt{c};
+}
$ENV{wdSession} ||= 'WebDAO::SessionSH';
$ENV{wdShell} = 1;
my $ini = WebDAO::Util::get_classes( __env => \%ENV, __preload => 1 );
#Make Session object
-my $store_obj = "$ini->{wdStore}"->new( %{ $ini->{wdStorePar} } );
my $cv = WebDAO::CV->new(
env => \%ENV,
writer => sub {
@@ -84,7 +90,6 @@ my $cv = WebDAO::CV->new(
my $sess = "$ini->{wdSession}"->new(
%{ $ini->{wdSessionPar} },
- store => $store_obj,
cv => $cv,
);
@@ -138,6 +143,13 @@ print "\n";
-man - print man page
-f file - set root [x]html file
-d - dump HTTP headers
+ -u login:password - set HTTP_AUTHORIZATION variable
+
+ examples:
+
+ wd_shell.pl -wdEngine Test -wdEnginePar config=../test.ini /some/url/query
+ wd_shell.pl -M Test -c ../test.ini /some/url/query #the same
+
=head1 OPTIONS
@@ -171,7 +183,7 @@ Zahatski Aliaksandr, E<lt>zag@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
-Copyright 2000-2012 by Zahatski Aliaksandr
+Copyright 2000-2013 by Zahatski Aliaksandr
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
@@ -22,16 +22,13 @@ my $handler = sub {
$env->{wdEnginePar} = $ENV{wdEnginePar} || $env->{HTTP_WDENGINEPAR} ;
$env->{wdEngine} = $ENV{wdEngine} || $env->{HTTP_WDENGINE} ;
$env->{wdSession} = $ENV{wdSession} || $env->{HTTP_WDSESSION} || 'WebDAO::Session' ;
+ $env->{wdSessionPar} = $ENV{wdSessionPar};
my $ini = WebDAO::Util::get_classes(__env => $env, __preload=>1);
- my $store_obj = "$ini->{wdStore}"->new(
- %{ $ini->{wdStorePar} }
- );
my $cv = WebDAO::CV->new(env=>$env, writer=>$coderef);
my $sess = "$ini->{wdSession}"->new(
%{ $ini->{wdSessionPar} },
- store => $store_obj,
cv => $cv,
);
@@ -19,7 +19,7 @@ sub headers { return $_[0]->{headers} }
package main;
-use Test::More ( tests => 35 );
+use Test::More ( tests => 33 );
use Data::Dumper;
use strict;
@@ -40,14 +40,12 @@ sub make_cv {
BEGIN {
use_ok('WebDAO');
- use_ok('WebDAO::Store::Abstract');
use_ok('WebDAO::SessionSH');
use_ok('WebDAO::Response');
use_ok( 'File::Temp', qw/ tempfile tempdir / );
}
my $ID = "tcontainer";
-ok my $store_ab = ( new WebDAO::Store::Abstract:: ), "Create store";
-ok my $session = ( new WebDAO::SessionSH:: store => $store_ab ),
+ok my $session = ( new WebDAO::SessionSH:: ),
"Create session";
$session->U_id($ID);
isa_ok my $response = ( new WebDAO::Response:: cv => &make_cv ),
@@ -1,41 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl 1.t'
-
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
-use Test::More tests=>10;
-use File::Temp qw/tempdir/;
-use Data::Dumper;
-use strict;
-BEGIN {
- use_ok('WebDAO');
- use_ok('WebDAO::Store::Abstract');
- use_ok('WebDAO::Store::Storable');
- use_ok('WebDAO::Container');
- use_ok('WebDAO::Engine');
- use_ok('WebDAO::SessionSH');
-
-}
-
-sub test_storage {
- my $object = shift;
- ok( $object, "Create Store " . ref($object) );
- my $ref = { test => 'test' };
- my $id = "ID";
- $object->store( $id, $ref );
- ok( $object->load($id)->{test} eq $ref->{test}, "Test load" );
-}
-my $dir = tempdir( CLEANUP => 1 );
-my $store_st = new WebDAO::Store::Storable:: path => $dir;
-test_storage($store_st);
-my $store_ab = new WebDAO::Store::Abstract::;
-ok( $store_ab, "Create abstract Store" );
-my $session = new WebDAO::SessionSH::;
-ok( $session, "Create abstract Store" );
-
-#########################
-
-# Insert your test code below, the Test::More module is use()ed here so read
-# its man page ( perldoc Test::More ) for help writing this test script.
-
@@ -1,89 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl 1.t'
-
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
-
-use Test::More tests => 28;
-
-#use Test::More (no_plan);
-use Data::Dumper;
-use File::Temp qw/tempdir/;
-use strict;
-
-BEGIN {
- use_ok('WebDAO');
- use_ok('WebDAO::Engine');
- use_ok('WebDAO::Store::Storable');
- use_ok('WebDAO::Container');
- use_ok('WebDAO::SessionSH');
- use lib 't/lib';
- use_ok('TestWDAO');
-}
-
-my $dir = tempdir( CLEANUP => 1 );
-my $ID = "tcontainer";
-my $store_ml = new WebDAO::Store::Storable:: path => $dir;
-my $session = new WebDAO::SessionSH:: store => $store_ml;
-$session->U_id($ID);
-my $test_class = 'TestWDAO';
-my $test_alias = "testclass";
-my $eng = new WebDAO::Engine::
- session => $session,
- register => { $test_class => $test_alias, 'WebDAO::Container' => 'contaner' };
-my $telement = $eng->_createObj( "t1", $test_alias );
-ok( $telement, "Create test1 object" );
-ok( $telement->_obj_name eq 't1', " test obj name" );
-$eng->_add_childs_($telement);
-is $telement->_sess1, 1, 'check defaults mk_sess_attr ';
-is $telement->_sess3, undef, 'undef default for _sess3 ';
-is $telement->_sess4, 'undef', 'undef default for _sess4 ';
-$telement->_sess2(6);
-#test mk_attr
-is $telement->_prop2, 3, 'mk_attr: check defaults';
-is $telement->_prop3, undef, 'mk_attr: check undef defaults';
-is $telement->_prop4, 'undef', 'mk_attr: check "undef" defaults';
-
-is $telement->_prop2(2), 3, 'mk_attr: check return prev default value';
-is $telement->_prop2(4), 2, 'mk_attr: check return prev value';
-is $telement->_prop2(), 4, 'mk_attr: check return value';
-ok exists $telement->{_prop2}, 'mk_attr: \$telement->{_prop2}';
-delete $telement->{_prop2};
-is $telement->_prop2(2), 3, 'mk_attr: check return prev default value after delete \$telement->{_prop2}';
-
-my $obj_by_name = $eng->_get_obj_by_name('t1');
-ok( $obj_by_name, "test get obj by name" );
-ok( $telement->_obj_name eq $obj_by_name->_obj_name, " test eq obj name" );
-my $tcontainer = $eng->_createObj( 'c1', 'contaner' );
-ok( $tcontainer, "test create container" );
-my $t2 = $eng->_createObj( "t2", $test_alias );
-ok( $t2, "Create test2 object" );
-$tcontainer->_add_childs_($t2);
-$eng->_add_childs_($tcontainer);
-ok( @{ $eng->_get_childs_ } == 2, 'Test count of inserted' );
-my $t3 = $eng->_createObj( "t3", $test_alias );
-ok( $t3, "Create test3 object" );
-$tcontainer->_add_childs_($t3);
-$eng->_destroy;
-$session->flush_session;
-
-my $store_ml1 = new WebDAO::Store::Storable:: path => $dir;
-my $session1 = new WebDAO::SessionSH:: store => $store_ml1;
-$session1->U_id($ID);
-my $eng1 = new WebDAO::Engine::
- session => $session1,
- register => { $test_class => $test_alias, 'WebDAO::Container' => 'contaner' };
-my $telement_ = $eng1->_createObj( "t1", $test_alias );
-ok( $telement_, "Create test1 object" );
-ok( $telement_->_obj_name eq 't1', " test obj name" );
-$eng1->_add_childs_($telement_);
-ok( $telement_->_sess2 == 6, "test restore attr" );
-
-#print Dumper($eng->__obj);
-
-#########################
-
-# Insert your test code below, the Test::More module is use()ed here so read
-# its man page ( perldoc Test::More ) for help writing this test script.
-
@@ -35,12 +35,10 @@ use warnings;
use Data::Dumper;
-use Test::More tests => 16;
+use Test::More tests => 14;
-#use Test::More qw(no_plan);
BEGIN {
- use_ok('WebDAO::Store::Abstract');
use_ok('WebDAO::SessionSH');
use_ok('WebDAO::Engine');
use_ok('WebDAO::Container');
@@ -48,8 +46,7 @@ BEGIN {
}
my $ID = "extra";
-ok my $store_ab = ( new WebDAO::Store::Abstract:: ), "Create store";
-ok my $session = ( new WebDAO::SessionSH:: store => $store_ab ),
+ok my $session = ( new WebDAO::SessionSH::),
"Create session";
$session->U_id($ID);
@@ -4,7 +4,6 @@
#
# AUTHOR: Aliaksandr P. Zahatski, <zahatski@gmail.com>
#===============================================================================
-#$Id$
package main;
#use Test::More tests => 1; # last test to print
@@ -53,7 +52,6 @@ is_deeply $r->[0]->attr, {
BEGIN {
- use_ok('WebDAO::Store::Abstract');
use_ok('WebDAO::SessionSH');
use_ok('WebDAO::Engine');
use_ok('WebDAO::Container');
@@ -61,8 +59,7 @@ BEGIN {
}
my $ID = "extra";
-ok my $store_ab = ( new WebDAO::Store::Abstract:: ), "Create store";
-ok my $session = ( new WebDAO::SessionSH:: store => $store_ab ),
+ok my $session = ( new WebDAO::SessionSH::),
"Create session";
$session->U_id($ID);
@@ -89,13 +89,13 @@ $r->content_length(2345);
$r->set_cookie( name => 'test', value => 1 );
$r->set_cookie( name => 'test1', value => 2, expires => 1327501188 );
$r->print_header();
-is_deeply $r->_cv_obj->{fd}->headers,
- [
+is_deeply {@{ $r->_cv_obj->{fd}->headers}} ,
+ {
'Content-Length' => 2345,
'Content-Type' => 'text/html; charset=utf-8',
'Set-Cookie' => 'test=1; path=/',
'Set-Cookie' => 'test1=2; path=/ ;expires=Wed, 25-Jan-2012 14:19:48 GMT'
- ],
+ },
'Set Cookies';
my $cv2 = $fcgi;
@@ -5,7 +5,7 @@
# change 'tests => 1' to 'tests => last_test_to_print';
-use Test::More tests => 12;
+use Test::More tests => 11;
#use Test::More (no_plan);
use Data::Dumper;
@@ -21,8 +21,7 @@ BEGIN {
use_ok('TestWDAO');
}
my $ID = "tcontainer";
-ok( ( my $store_ab = new WebDAO::Store::Abstract:: ), "Create store" );
-ok( ( my $session = new WebDAO::SessionSH:: store => $store_ab ),
+ok( ( my $session = new WebDAO::SessionSH::),
"Create session" );
$session->U_id($ID);
@@ -155,16 +155,15 @@ use Data::Dumper;
use Test::More;
use base 'Test';
-sub setup : Test(setup=>2) {
+sub setup : Test(setup=>1) {
my $t = shift;
- ok( ( my $store_ab = new WebDAO::Store::Abstract:: ), "Create store" );
my $buffer;
$t->{OUT} = \$buffer;
my $cv = new TestCV:: \$buffer;
#don't print headers
$cv->{SKIP_HEADERS} =1;
ok(
- ( my $session = new WebDAO::SessionSH:: store => $store_ab, cv => $cv ),
+ ( my $session = new WebDAO::SessionSH:: cv => $cv ),
"Create session"
);
$session->U_id("sdsd");
@@ -20,7 +20,6 @@ Class for tests
use Test::Class;
use WebDAO::Test;
-use WebDAO::Store::Abstract;
use WebDAO::SessionSH;
use WebDAO::Engine;
use Test::More;
@@ -36,13 +35,12 @@ sub SKIP_CLASS {
return 1 if $class eq __PACKAGE__;
}
-sub setup : Test(setup=>2) {
+sub setup : Test(setup=>1) {
my $t = shift;
- ok( ( my $store_ab = new WebDAO::Store::Abstract:: ), "Create store" );
my $buffer='';
$t->{OUT}=\$buffer;
my $cv = new TestCV:: \$buffer;
- ok( ( my $session = new WebDAO::SessionSH:: store => $store_ab, cv=>$cv ),
+ ok( ( my $session = new WebDAO::SessionSH:: cv=>$cv ),
"Create session" );
$session->U_id("sdsd");
my $eng = new WebDAO::Engine:: session => $session;
@@ -1,13 +1,11 @@
package TestWDAO;
use WebDAO::Element;
use base 'WebDAO::Element';
-__PACKAGE__->mk_sess_attr( _sess1=>1, _sess2=>3, _sess3=>undef, _sess4=>'undef');
__PACKAGE__->mk_attr( _prop1=>1, _prop2=>3, _prop3=>undef, _prop4=>'undef', __test1=>undef, _test2=>undef);
sub init {
my $self = shift;
- _sess2 $self (3)
}
sub Echo {
my $self = shift;