Line # Revision Author
1 8 ahitrov@rambler.ru package @NAME@::State;
2
3 use strict;
4 use warnings 'all';
5 use vars qw($AUTOLOAD);
6
7
8 sub new {
9 my ($proto) = @_;
10 my $class = ref($proto) || $proto;
11 my $self = {};
12 bless $self, $class;
13
14 217 ahitrov # configured
15 $self->{debug} = (lc('@DEBUG@') eq 'yes');
16 $self->{project} = '@PROJECT@';
17
18 8 ahitrov@rambler.ru # зашитая конфигурация плагина
19 217 ahitrov $self->{db_type} = 'none'; ### For REAL database use 'remote'
20 $self->{db_keepalive} = 0;
21 $self->{db_host} = '';
22 $self->{db_name} = '';
23 $self->{db_user} = '';
24 $self->{db_password} = '';
25 $self->{db_port} = '';
26 $self->{store_method} = 'toast';
27 $self->{cascade} = 1;
28 $self->{db_prepare} = 0;
29 8 ahitrov@rambler.ru
30 217 ahitrov $self->{memcached_enable} = lc( '@MEMCACHED_ENABLE@' ) eq 'yes' ? 1 : 0;
31 $self->{memcached_enable_compress} = 1;
32 $self->{memcached_backend} = '@MEMCACHED_BACKEND@';
33 $self->{memcached_servers} = [qw(@MEMCACHED_SERVERS@)];
34 $self->{memcached_busy_lock} = 60;
35 $self->{memcached_delayed} = lc('@MEMCACHED_DELAYED@') eq 'yes' ? 1 : 0;
36
37 $self->{serialize_with} = 'json'; ### or 'dumper'
38
39 # not implemented really (core compatibility)
40 $self->{binary_directory} = '/nonexistent';
41 $self->{data_directory} = '/nonexistent';
42 $self->{images_directory} = '/nonexistent';
43 $self->{preview} = '0';
44
45 8 ahitrov@rambler.ru $self->_init_();
46 $self;
47 }
48
49 sub info {
50 my $self = shift;
51 return unless ref $self;
52
53 for (sort keys %{$self->{attributes}}) {
54 my $la = length $_;
55 warn "\t$_".("\t" x (2-int($la/8))).": $self->{$_}\n";
56 }
57 }
58
59 sub _init_ {
60 my $self = shift;
61
62 # зашитая конфигурация плагина
63 $self->{attributes}->{$_} = 'SCALAR' for qw(
64 217 ahitrov debug
65 project
66
67 db_type
68 db_keepalive
69 db_host
70 db_port
71 db_name
72 db_user
73 db_password
74 store_method
75 cascade
76 db_prepare
77 db_client_encoding
78
79 memcached_enable
80 memcached_enable_compress
81 memcached_backend
82 memcached_servers
83 memcached_busy_lock
84 memcached_delayed
85
86 binary_directory
87 data_directory
88 images_directory
89 preview
90 8 ahitrov@rambler.ru );
91 }
92
93 sub AUTOLOAD {
94 my $self = shift;
95 my $attribute = $AUTOLOAD;
96
97 $attribute =~ s/.*:://;
98 return unless $attribute =~ /[^A-Z]/; # Отключаем методы типа DESTROY
99
100 if (!exists $self->{attributes}->{$attribute}) {
101 warn "Contenido Error (@NAME@::State): Вызов метода, для которого не существует обрабатываемого свойства: ->$attribute()\n";
102 return;
103 }
104
105 $self->{$attribute} = shift @_ if $#_>=0;
106 $self->{$attribute};
107 }
108
109 1;