← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:16 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Class/Base.pm
StatementsExecuted 7224 statements in 8.52ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
383734.59ms57.7msClass::Base::::newClass::Base::new
740522.22ms2.22msClass::Base::::errorClass::Base::error
2442129µs129µsClass::Base::::debugClass::Base::debug
11113µs15µsClass::Base::::BEGIN@23Class::Base::BEGIN@23
11110µs17µsClass::Base::::BEGIN@231Class::Base::BEGIN@231
1117µs22µsClass::Base::::BEGIN@46Class::Base::BEGIN@46
1117µs14µsClass::Base::::BEGIN@256Class::Base::BEGIN@256
1116µs14µsClass::Base::::BEGIN@109Class::Base::BEGIN@109
0000s0sClass::Base::::cloneClass::Base::clone
0000s0sClass::Base::::debuggingClass::Base::debugging
0000s0sClass::Base::::idClass::Base::id
0000s0sClass::Base::::initClass::Base::init
0000s0sClass::Base::::paramsClass::Base::params
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1#============================================================= -*-perl-*-
2#
3# Class::Base
4#
5# DESCRIPTION
6# Module implementing a common base class from which other modules
7# can be derived.
8#
9# AUTHOR
10# Andy Wardley <abw@kfs.org>
11#
12# COPYRIGHT
13# Copyright (C) 1996-2002 Andy Wardley. All Rights Reserved.
14#
15# This module is free software; you can redistribute it and/or
16# modify it under the same terms as Perl itself.
17#
18#
19#========================================================================
20
21package Class::Base;
22
23376µs218µs
# spent 15µs (13+2) within Class::Base::BEGIN@23 which was called: # once (13µs+2µs) by base::import at line 23
use strict;
# spent 15µs making 1 call to Class::Base::BEGIN@23 # spent 2µs making 1 call to strict::import
24
251500nsour $VERSION = '0.04';
26
27
28#------------------------------------------------------------------------
29# new(@config)
30# new(\%config)
31#
32# General purpose constructor method which expects a hash reference of
33# configuration parameters, or a list of name => value pairs which are
34# folded into a hash. Blesses a hash into an object and calls its
35# init() method, passing the parameter hash reference. Returns a new
36# object derived from Class::Base, or undef on error.
37#------------------------------------------------------------------------
38
39
# spent 57.7ms (4.59+53.1) within Class::Base::new which was called 383 times, avg 151µs/call: # 240 times (2.79ms+35.1ms) by SQL::Translator::Schema::Table::add_field at line 333 of SQL/Translator/Schema/Table.pm, avg 158µs/call # 67 times (693µs+7.58ms) by SQL::Translator::Schema::Table::add_constraint at line 126 of SQL/Translator/Schema/Table.pm, avg 123µs/call # 35 times (595µs+1.16ms) by SQL::Translator::Schema::Table::new at line 82 of SQL/Translator/Schema/Table.pm, avg 50µs/call # 31 times (334µs+2.09ms) by SQL::Translator::Schema::Table::add_index at line 249 of SQL/Translator/Schema/Table.pm, avg 78µs/call # 4 times (99µs+6.89ms) by DBIx::Class::Storage::DBI::deployment_statements at line 2725 of DBIx/Class/Storage/DBI.pm, avg 1.75ms/call # 4 times (56µs+132µs) by SQL::Translator::Schema::new at line 65 of SQL/Translator/Schema.pm, avg 47µs/call # 2 times (29µs+186µs) by SQL::Translator::Schema::add_view at line 420 of SQL/Translator/Schema.pm, avg 107µs/call
sub new {
4019154.09ms my $class = shift;
41
42 # allow hash ref as first argument, otherwise fold args into hash
43383210µs my $config = defined $_[0] && UNIVERSAL::isa($_[0], 'HASH')
# spent 210µs making 383 calls to UNIVERSAL::isa, avg 549ns/call
44 ? shift : { @_ };
45
463167µs236µs
# spent 22µs (7+15) within Class::Base::BEGIN@46 which was called: # once (7µs+15µs) by base::import at line 46
no strict 'refs';
# spent 22µs making 1 call to Class::Base::BEGIN@46 # spent 15µs making 1 call to strict::unimport
47 my $debug = defined $config->{ debug }
48 ? $config->{ debug }
49 : defined $config->{ DEBUG }
50 ? $config->{ DEBUG }
51 : ( ${"$class\::DEBUG"} || 0 );
52
53 my $self = bless {
54 _ID => $config->{ id } || $config->{ ID } || $class,
55 _DEBUG => $debug,
56 _ERROR => '',
57 }, $class;
58
591518µs65852.9ms return $self->init($config)
# spent 37.2ms making 312 calls to SQL::Translator::Schema::Object::init, avg 119µs/call # spent 7.55ms making 67 calls to SQL::Translator::Schema::Constraint::init, avg 113µs/call # spent 6.88ms making 4 calls to SQL::Translator::init, avg 1.72ms/call # spent 1.06ms making 240 calls to SQL::Translator::Schema::Field::__ANON__[SQL/Translator/Schema/Field.pm:58], avg 4µs/call # spent 186µs making 35 calls to SQL::Translator::Schema::Table::__ANON__[SQL/Translator/Schema/Table.pm:59], avg 5µs/call
60 || $class->error($self->error());
61}
62
63
64#------------------------------------------------------------------------
65# init()
66#
67# Initialisation method called by the new() constructor and passing a
68# reference to a hash array containing any configuration items specified
69# as constructor arguments. Should return $self on success or undef on
70# error, via a call to the error() method to set the error message.
71#------------------------------------------------------------------------
72
73sub init {
74 my ($self, $config) = @_;
75 return $self;
76}
77
78
79#------------------------------------------------------------------------
80# clone()
81#
82# Method to perform a simple clone of the current object hash and return
83# a new object.
84#------------------------------------------------------------------------
85
86sub clone {
87 my $self = shift;
88 bless { %$self }, ref($self);
89}
90
91
92#------------------------------------------------------------------------
93# error()
94# error($msg, ...)
95#
96# May be called as a class or object method to set or retrieve the
97# package variable $ERROR (class method) or internal member
98# $self->{ _ERROR } (object method). The presence of parameters indicates
99# that the error value should be set. Undef is then returned. In the
100# abscence of parameters, the current error value is returned.
101#------------------------------------------------------------------------
102
103
# spent 2.22ms within Class::Base::error which was called 740 times, avg 3µs/call: # 458 times (1.28ms+0s) by SQL::Translator::Schema::Table::get_constraints at line 460 of SQL/Translator/Schema/Table.pm, avg 3µs/call # 240 times (760µs+0s) by SQL::Translator::Schema::Table::get_field at line 514 of SQL/Translator/Schema/Table.pm, avg 3µs/call # 35 times (152µs+0s) by SQL::Translator::Schema::Table::get_indices at line 486 of SQL/Translator/Schema/Table.pm, avg 4µs/call # 4 times (15µs+0s) by SQL::Translator::Schema::get_triggers at line 660 of SQL/Translator/Schema.pm, avg 4µs/call # 3 times (13µs+0s) by SQL::Translator::Schema::get_views at line 708 of SQL/Translator/Schema.pm, avg 4µs/call
sub error {
1042960661µs my $self = shift;
105 my $errvar;
106
107 {
108 # get a reference to the object or package variable we're munging
1093326µs222µs
# spent 14µs (6+8) within Class::Base::BEGIN@109 which was called: # once (6µs+8µs) by base::import at line 109
no strict qw( refs );
# spent 14µs making 1 call to Class::Base::BEGIN@109 # spent 8µs making 1 call to strict::unimport
110740465µs $errvar = ref $self ? \$self->{ _ERROR } : \${"$self\::ERROR"};
111 }
11214801.75ms if (@_) {
113 # don't join if first arg is an object (may force stringification)
114 $$errvar = ref($_[0]) ? shift : join('', @_);
115 return undef;
116 }
117 else {
118 return $$errvar;
119 }
120}
121
- -
124#------------------------------------------------------------------------
125# id($new_id)
126#
127# Method to get/set the internal _ID field which is used to identify
128# the object for the purposes of debugging, etc.
129#------------------------------------------------------------------------
130
131sub id {
132 my $self = shift;
133
134 # set _ID with $obj->id('foo')
135 return ($self->{ _ID } = shift) if ref $self && @_;
136
137 # otherwise return id as $self->{ _ID } or class name
138 my $id = $self->{ _ID } if ref $self;
139 $id ||= ref($self) || $self;
140
141 return $id;
142}
143
144
145#------------------------------------------------------------------------
146# params($vals, @keys)
147# params($vals, \@keys)
148# params($vals, \%keys)
149#
150# Utility method to examine the $config hash for any keys specified in
151# @keys and copy the values into $self. Keys should be specified as a
152# list or reference to a list of UPPER CASE names. The method looks
153# for either the name in either UPPER or lower case in the $config
154# hash and copies the value, if defined, into $self. The keys can
155# also be specified as a reference to a hash containing default values
156# or references to handler subroutines which will be called, passing
157# ($self, $config, $UPPER_KEY_NAME) as arguments.
158#------------------------------------------------------------------------
159
160sub params {
161 my $self = shift;
162 my $vals = shift;
163 my ($keys, @names);
164 my ($key, $lckey, $default, $value, @values);
165
166
167 if (@_) {
168 if (ref $_[0] eq 'ARRAY') {
169 $keys = shift;
170 @names = @$keys;
171 $keys = { map { ($_, undef) } @names };
172 }
173 elsif (ref $_[0] eq 'HASH') {
174 $keys = shift;
175 @names = keys %$keys;
176 }
177 else {
178 @names = @_;
179 $keys = { map { ($_, undef) } @names };
180 }
181 }
182 else {
183 $keys = { };
184 }
185
186 foreach $key (@names) {
187 $lckey = lc $key;
188
189 # look for value provided in $vals hash
190 defined($value = $vals->{ $key })
191 || ($value = $vals->{ $lckey });
192
193 # look for default which may be a code handler
194 if (defined ($default = $keys->{ $key })
195 && ref $default eq 'CODE') {
196 eval {
197 $value = &$default($self, $key, $value);
198 };
199 return $self->error($@) if $@;
200 }
201 else {
202 $value = $default unless defined $value;
203 $self->{ $key } = $value if defined $value;
204 }
205 push(@values, $value);
206 delete @$vals{ $key, lc $key };
207 }
208 return wantarray ? @values : \@values;
209}
210
211
212#------------------------------------------------------------------------
213# debug(@args)
214#
215# Debug method which prints all arguments passed to STDERR if and only if
216# the appropriate DEBUG flag(s) are set. If called as an object method
217# where the object has a _DEBUG member defined then the value of that
218# flag is used. Otherwise, the $DEBUG package variable in the caller's
219# class is used as the flag to enable/disable debugging.
220#------------------------------------------------------------------------
221
222
# spent 129µs within Class::Base::debug which was called 24 times, avg 5µs/call: # 8 times (36µs+0s) by SQL::Translator::load at line 765 of SQL/Translator.pm, avg 4µs/call # 8 times (23µs+0s) by SQL::Translator::_tool at line 670 of SQL/Translator.pm, avg 3µs/call # 4 times (55µs+0s) by SQL::Translator::translate at line 516 of SQL/Translator.pm, avg 14µs/call # 4 times (15µs+0s) by SQL::Translator::Producer::SQLite::produce at line 55 of SQL/Translator/Producer/SQLite.pm, avg 4µs/call
sub debug {
22396129µs my $self = shift;
224 my ($flag);
225
2261614µs if (ref $self && defined $self->{ _DEBUG }) {
227 $flag = $self->{ _DEBUG };
228 }
229 else {
230 # go looking for package variable
231377µs224µs
# spent 17µs (10+7) within Class::Base::BEGIN@231 which was called: # once (10µs+7µs) by base::import at line 231
no strict 'refs';
# spent 17µs making 1 call to Class::Base::BEGIN@231 # spent 8µs making 1 call to strict::unimport
232 $self = ref $self || $self;
233 $flag = ${"$self\::DEBUG"};
234 }
235
236 return unless $flag;
237
238 print STDERR '[', $self->id, '] ', @_;
239}
240
241
242#------------------------------------------------------------------------
243# debugging($flag)
244#
245# Method to turn debugging on/off (when called with an argument) or to
246# retrieve the current debugging status (when called without). Changes
247# to the debugging status are propagated to the $DEBUG variable in the
248# caller's package.
249#------------------------------------------------------------------------
250
251sub debugging {
252 my $self = shift;
253 my $class = ref $self;
254 my $flag;
255
2563252µs222µs
# spent 14µs (7+7) within Class::Base::BEGIN@256 which was called: # once (7µs+7µs) by base::import at line 256
no strict 'refs';
# spent 14µs making 1 call to Class::Base::BEGIN@256 # spent 7µs making 1 call to strict::unimport
257
258 my $dbgvar = ref $self ? \$self->{ _DEBUG } : \${"$self\::DEBUG"};
259
260 return @_ ? ($$dbgvar = shift)
261 : $$dbgvar;
262
263}
264
265
26613µs1;
267
268
269=head1 NAME
270
271Class::Base - useful base class for deriving other modules
272
273=head1 SYNOPSIS
274
275 package My::Funky::Module;
276 use base qw( Class::Base );
277
278 # custom initialiser method
279 sub init {
280 my ($self, $config) = @_;
281
282 # copy various params into $self
283 $self->params($config, qw( FOO BAR BAZ ))
284 || return undef;
285
286 # to indicate a failure
287 return $self->error('bad constructor!')
288 if $something_bad;
289
290 # or to indicate general happiness and well-being
291 return $self;
292 }
293
294 package main;
295
296 # new() constructor folds args into hash and calls init()
297 my $object = My::Funky::Module->new( foo => 'bar', ... )
298 || die My::Funky::Module->error();
299
300 # error() class/object method to get/set errors
301 $object->error('something has gone wrong');
302 print $object->error();
303
304 # debugging() method (de-)activates the debug() method
305 $object->debugging(1);
306
307 # debug() prints to STDERR if debugging enabled
308 $object->debug('The ', $animal, ' sat on the ', $place);
309
310
311=head1 DESCRIPTION
312
313Please consider using L<Badger::Base> instead which is the successor of
314this module.
315
316This module implements a simple base class from which other modules
317can be derived, thereby inheriting a number of useful methods such as
318C<new()>, C<init()>, C<params()>, C<clone()>, C<error()> and
319C<debug()>.
320
321For a number of years, I found myself re-writing this module for
322practically every Perl project of any significant size. Or rather, I
323would copy the module from the last project and perform a global
324search and replace to change the names. Each time it got a little
325more polished and eventually, I decided to Do The Right Thing and
326release it as a module in it's own right.
327
328It doesn't pretend to be an all-encompassing solution for every kind
329of object creation problem you might encounter. In fact, it only
330supports blessed hash references that are created using the popular,
331but by no means universal convention of calling C<new()> with a list
332or reference to a hash array of named parameters. Constructor failure
333is indicated by returning undef and setting the C<$ERROR> package
334variable in the module's class to contain a relevant message (which
335you can also fetch by calling C<error()> as a class method).
336
337e.g.
338
339 my $object = My::Module->new(
340 file => 'myfile.html',
341 msg => 'Hello World'
342 ) || die $My::Module::ERROR;
343
344or:
345
346 my $object = My::Module->new({
347 file => 'myfile.html',
348 msg => 'Hello World',
349 }) || die My::Module->error();
350
351The C<new()> method handles the conversion of a list of arguments
352into a hash array and calls the C<init()> method to perform any
353initialisation. In many cases, it is therefore sufficient to define
354a module like so:
355
356 package My::Module;
357 use Class::Base;
358 use base qw( Class::Base );
359
360 sub init {
361 my ($self, $config) = @_;
362 # copy some config items into $self
363 $self->params($config, qw( FOO BAR )) || return undef;
364 return $self;
365 }
366
367 # ...plus other application-specific methods
368
369 1;
370
371Then you can go right ahead and use it like this:
372
373 use My::Module;
374
375 my $object = My::Module->new( FOO => 'the foo value',
376 BAR => 'the bar value' )
377 || die $My::Module::ERROR;
378
379Despite its limitations, Class::Base can be a surprisingly useful
380module to have lying around for those times where you just want to
381create a regular object based on a blessed hash reference and don't
382want to worry too much about duplicating the same old code to bless a
383hash, define configuration values, provide an error reporting
384mechanism, and so on. Simply derive your module from C<Class::Base>
385and leave it to worry about most of the detail. And don't forget, you
386can always redefine your own C<new()>, C<error()>, or other method, if
387you don't like the way the Class::Base version works.
388
389=head2 Subclassing Class::Base
390
391This module is what object-oriented afficionados would describe as an
392"abstract base class". That means that it's not designed to be used
393as a stand-alone module, rather as something from which you derive
394your own modules. Like this:
395
396 package My::Funky::Module
397 use base qw( Class::Base );
398
399You can then use it like this:
400
401 use My::Funky::Module;
402
403 my $module = My::Funky::Module->new();
404
405=head2 Construction and Initialisation Methods
406
407If you want to apply any per-object initialisation, then simply write
408an C<init()> method. This gets called by the C<new()> method which
409passes a reference to a hash reference of configuration options.
410
411 sub init {
412 my ($self, $config) = @_;
413
414 ...
415
416 return $self;
417 }
418
419When you create new objects using the C<new()> method you can either
420pass a hash reference or list of named arguments. The C<new()> method
421does the right thing to fold named arguments into a hash reference for
422passing to the C<init()> method. Thus, the following are equivalent:
423
424 # hash reference
425 my $module = My::Funky::Module->new({
426 foo => 'bar',
427 wiz => 'waz',
428 });
429
430 # list of named arguments (no enclosing '{' ... '}')
431 my $module = My::Funky::Module->new(
432 foo => 'bar',
433 wiz => 'waz'
434 );
435
436Within the C<init()> method, you can either handle the configuration
437yourself:
438
439 sub init {
440 my ($self, $config) = @_;
441
442 $self->{ file } = $config->{ file }
443 || return $self->error('no file specified');
444
445 return $self;
446 }
447
448or you can call the C<params()> method to do it for you:
449
450 sub init {
451 my ($self, $config) = @_;
452
453 $self->params($config, 'file')
454 || return $self->error('no file specified');
455
456 return $self;
457 }
458
459=head2 Error Handling
460
461The C<init()> method should return $self to indicate success or undef
462to indicate a failure. You can use the C<error()> method to report an
463error within the C<init()> method. The C<error()> method returns undef,
464so you can use it like this:
465
466 sub init {
467 my ($self, $config) = @_;
468
469 # let's make 'foobar' a mandatory argument
470 $self->{ foobar } = $config->{ foobar }
471 || return $self->error("no foobar argument");
472
473 return $self;
474 }
475
476When you create objects of this class via C<new()>, you should now
477check the return value. If undef is returned then the error message
478can be retrieved by calling C<error()> as a class method.
479
480 my $module = My::Funky::Module->new()
481 || die My::Funky::Module->error();
482
483Alternately, you can inspect the C<$ERROR> package variable which will
484contain the same error message.
485
486 my $module = My::Funky::Module->new()
487 || die $My::Funky::Module::ERROR;
488
489Of course, being a conscientious Perl programmer, you will want to be
490sure that the C<$ERROR> package variable is correctly defined.
491
492 package My::Funky::Module
493 use base qw( Class::Base );
494
495 our $ERROR;
496
497You can also call C<error()> as an object method. If you pass an
498argument then it will be used to set the internal error message for
499the object and return undef. Typically this is used within the module
500methods to report errors.
501
502 sub another_method {
503 my $self = shift;
504
505 ...
506
507 # set the object error
508 return $self->error('something bad happened');
509 }
510
511If you don't pass an argument then the C<error()> method returns the
512current error value. Typically this is called from outside the object
513to determine its status. For example:
514
515 my $object = My::Funky::Module->new()
516 || die My::Funky::Module->error();
517
518 $object->another_method()
519 || die $object->error();
520
521=head2 Debugging Methods
522
523The module implements two methods to assist in writing debugging code:
524debug() and debugging(). Debugging can be enabled on a per-object or
525per-class basis, or as a combination of the two.
526
527When creating an object, you can set the C<DEBUG> flag (or lower case
528C<debug> if you prefer) to enable or disable debugging for that one
529object.
530
531 my $object = My::Funky::Module->new( debug => 1 )
532 || die My::Funky::Module->error();
533
534 my $object = My::Funky::Module->new( DEBUG => 1 )
535 || die My::Funky::Module->error();
536
537If you don't explicitly specify a debugging flag then it assumes the
538value of the C<$DEBUG> package variable in your derived class or 0 if
539that isn't defined.
540
541You can also switch debugging on or off via the C<debugging()> method.
542
543 $object->debugging(0); # debug off
544 $object->debugging(1); # debug on
545
546The C<debug()> method examines the internal debugging flag (the
547C<_DEBUG> member within the C<$self> hash) and if it finds it set to
548any true value then it prints to STDERR all the arguments passed to
549it. The output is prefixed by a tag containing the class name of the
550object in square brackets (but see the C<id()> method below for
551details on how to change that value).
552
553For example, calling the method as:
554
555 $object->debug('foo', 'bar');
556
557prints the following output to STDERR:
558
559 [My::Funky::Module] foobar
560
561When called as class methods, C<debug()> and C<debugging()> instead
562use the C<$DEBUG> package variable in the derived class as a flag to
563control debugging. This variable also defines the default C<DEBUG>
564flag for any objects subsequently created via the new() method.
565
566 package My::Funky::Module
567 use base qw( Class::Base );
568
569 our $ERROR;
570 our $DEBUG = 0 unless defined $DEBUG;
571
572 # some time later, in a module far, far away
573 package main;
574
575 # debugging off (by default)
576 my $object1 = My::Funky::Module->new();
577
578 # turn debugging on for My::Funky::Module objects
579 $My::Funky::Module::DEBUG = 1;
580
581 # alternate syntax
582 My::Funky::Module->debugging(1);
583
584 # debugging on (implicitly from $DEBUG package var)
585 my $object2 = My::Funky::Module->new();
586
587 # debugging off (explicit override)
588 my $object3 = My::Funky::Module->new(debug => 0);
589
590If you call C<debugging()> without any arguments then it returns the
591value of the internal object flag or the package variable accordingly.
592
593 print "debugging is turned ", $object->debugging() ? 'on' : 'off';
594
595=head1 METHODS
596
597=head2 new()
598
599Class constructor method which expects a reference to a hash array of parameters
600or a list of C<name =E<gt> value> pairs which are automagically folded into
601a hash reference. The method blesses a hash reference and then calls the
602C<init()> method, passing the reference to the hash array of configuration
603parameters.
604
605Returns a reference to an object on success or undef on error. In the latter
606case, the C<error()> method can be called as a class method, or the C<$ERROR>
607package variable (in the derived class' package) can be inspected to return an
608appropriate error message.
609
610 my $object = My::Class->new( foo => 'bar' ) # params list
611 || die $My::Class::$ERROR; # package var
612
613or
614
615 my $object = My::Class->new({ foo => 'bar' }) # params hashref
616 || die My::Class->error; # class method
617
618
619=head2 init(\%config)
620
621Object initialiser method which is called by the C<new()> method, passing
622a reference to a hash array of configuration parameters. The method may
623be derived in a subclass to perform any initialisation required. It should
624return C<$self> on success, or C<undef> on error, via a call to the C<error()>
625method.
626
627 package My::Module;
628 use base qw( Class::Base );
629
630 sub init {
631 my ($self, $config) = @_;
632
633 # let's make 'foobar' a mandatory argument
634 $self->{ foobar } = $config->{ foobar }
635 || return $self->error("no foobar argument");
636
637 return $self;
638 }
639
640=head2 params($config, @keys)
641
642The C<params()> method accept a reference to a hash array as the
643first argument containing configuration values such as those passed
644to the C<init()> method. The second argument can be a reference to
645a list of parameter names or a reference to a hash array mapping
646parameter names to default values. If the second argument is not
647a reference then all the remaining arguments are taken as parameter
648names. Thus the method can be called as follows:
649
650 sub init {
651 my ($self, $config) = @_;
652
653 # either...
654 $self->params($config, qw( foo bar ));
655
656 # or...
657 $self->params($config, [ qw( foo bar ) ]);
658
659 # or...
660 $self->params($config, { foo => 'default foo value',
661 bar => 'default bar value' } );
662
663 return $self;
664 }
665
666The method looks for values in $config corresponding to the keys
667specified and copies them, if defined, into $self.
668
669Keys can be specified in UPPER CASE and the method will look for
670either upper or lower case equivalents in the C<$config> hash. Thus
671you can call C<params()> from C<init()> like so:
672
673 sub init {
674 my ($self, $config) = @_;
675 $self->params($config, qw( FOO BAR ))
676 return $self;
677 }
678
679but use either case for parameters passed to C<new()>:
680
681 my $object = My::Module->new( FOO => 'the foo value',
682 BAR => 'the bar value' )
683 || die My::Module->error();
684
685 my $object = My::Module->new( foo => 'the foo value',
686 bar => 'the bar value' )
687 || die My::Module->error();
688
689Note however that the internal key within C<$self> used to store the
690value will be in the case provided in the call to C<params()> (upper
691case in this example). The method doesn't look for upper case
692equivalents when they are specified in lower case.
693
694When called in list context, the method returns a list of all the
695values corresponding to the list of keys, some of which may be
696undefined (allowing you to determine which values were successfully
697set if you need to). When called in scalar context it returns a
698reference to the same list.
699
700=head2 clone()
701
702The C<clone()> method performs a simple shallow copy of the object
703hash and creates a new object blessed into the same class. You may
704want to provide your own C<clone()> method to perform a more complex
705cloning operation.
706
707 my $clone = $object->clone();
708
709=head2 error($msg, ...)
710
711General purpose method for getting and setting error messages. When
712called as a class method, it returns the value of the C<$ERROR> package
713variable (in the derived class' package) if called without any arguments,
714or sets the same variable when called with one or more arguments. Multiple
715arguments are concatenated together.
716
717 # set error
718 My::Module->error('set the error string');
719 My::Module->error('set ', 'the ', 'error string');
720
721 # get error
722 print My::Module->error();
723 print $My::Module::ERROR;
724
725When called as an object method, it operates on the C<_ERROR> member
726of the object, returning it when called without any arguments, or
727setting it when called with arguments.
728
729 # set error
730 $object->error('set the error string');
731
732 # get error
733 print $object->error();
734
735The method returns C<undef> when called with arguments. This allows it
736to be used within object methods as shown:
737
738 sub my_method {
739 my $self = shift;
740
741 # set error and return undef in one
742 return $self->error('bad, bad, error')
743 if $something_bad;
744 }
745
746=head2 debug($msg, $msg, ...)
747
748Prints all arguments to STDERR if the internal C<_DEBUG> flag (when
749called as an object method) or C<$DEBUG> package variable (when called
750as a class method) is set to a true value. Otherwise does nothing.
751The output is prefixed by a string of the form "[Class::Name]" where
752the name of the class is that returned by the C<id()> method.
753
754=head2 debugging($flag)
755
756Used to get (no arguments) or set ($flag defined) the value of the
757internal C<_DEBUG> flag (when called as an object method) or C<$DEBUG>
758package variable (when called as a class method).
759
760=head2 id($newid)
761
762The C<debug()> method calls this method to return an identifier for
763the object for printing in the debugging message. By default it
764returns the class name of the object (i.e. C<ref $self>), but you can
765of course subclass the method to return some other value. When called
766with an argument it uses that value to set its internal C<_ID> field
767which will be returned by subsequent calls to C<id()>.
768
769=head1 AUTHOR
770
771Andy Wardley E<lt>abw@kfs.orgE<gt>
772
773=head1 VERSION
774
775This is version 0.04 of Class::Base.
776
777=head1 HISTORY
778
779This module began life as the Template::Base module distributed as
780part of the Template Toolkit.
781
782Thanks to Brian Moseley and Matt Sergeant for suggesting various
783enhancments, some of which went into version 0.02.
784
785Version 0.04 was uploaded by Gabor Szabo.
786
787=head1 COPYRIGHT
788
789Copyright (C) 1996-2012 Andy Wardley. All Rights Reserved.
790
791This module is free software; you can redistribute it and/or
792modify it under the same terms as Perl itself.
793
794=cut