From c3082909be025a2ba7c8975c2a1026efc4836477 Mon Sep 17 00:00:00 2001 From: Zag Date: Sun, 16 Nov 2014 15:29:15 +0300 Subject: [PATCH] remove deprecated code --- lib/WebDAO/Base.pm | 83 +-------------------------------------- lib/WebDAO/Container.pm | 13 ------ lib/WebDAO/Element.pm | 26 ------------ lib/WebDAO/Lib/RawHTML.pm | 6 ++- 4 files changed, 6 insertions(+), 122 deletions(-) diff --git a/lib/WebDAO/Base.pm b/lib/WebDAO/Base.pm index d413599..105d792 100755 --- a/lib/WebDAO/Base.pm +++ b/lib/WebDAO/Base.pm @@ -1,5 +1,4 @@ package WebDAO::Base; -#$Id$ =head1 NAME @@ -16,9 +15,10 @@ WebDAO::Base - Base class use Data::Dumper; use Carp; @WebDAO::Base::ISA = qw(Exporter); -@WebDAO::Base::EXPORT = qw(attributes); +@WebDAO::Base::EXPORT = qw(mk_attr); $DEBUG = 0; # assign 1 to it to see code generated on the fly + sub mk_attr { my ($pkg) = caller; shift if $_[0] =~ /\:\:/ or $_[0] eq $pkg; @@ -62,45 +62,6 @@ sub _define_attr_accessor { $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 { @@ -118,46 +79,6 @@ sub _define_constructor { $code; } -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 = {}; diff --git a/lib/WebDAO/Container.pm b/lib/WebDAO/Container.pm index fdaf81e..bdc9f86 100755 --- a/lib/WebDAO/Container.pm +++ b/lib/WebDAO/Container.pm @@ -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_() diff --git a/lib/WebDAO/Element.pm b/lib/WebDAO/Element.pm index 1ed5093..710e116 100755 --- a/lib/WebDAO/Element.pm +++ b/lib/WebDAO/Element.pm @@ -88,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_() @@ -224,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; diff --git a/lib/WebDAO/Lib/RawHTML.pm b/lib/WebDAO/Lib/RawHTML.pm index f98f577..17805ba 100755 --- a/lib/WebDAO/Lib/RawHTML.pm +++ b/lib/WebDAO/Lib/RawHTML.pm @@ -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, Ezag@cpan.orgE =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.