File Coverage

blib/lib/XAO/DO/Atom.pm
Criterion Covered Total %
statement 27 28 96.4
branch 6 8 75.0
condition 2 6 33.3
subroutine 6 6 100.0
pod 3 3 100.0
total 44 51 86.2


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             XAO::DO::Atom - recommended base object for all XAO dynamic objects
4              
5             =head1 SYNOPSIS
6              
7             Throwing an error from XAO object:
8              
9             throw $self "method - no 'foo' parameter";
10              
11             =head1 DESCRIPTION
12              
13             Provides some very basic functionality and common methods for all XAO
14             dynamic objects.
15              
16             Atom (XAO::DO::Atom) was introduced in the release 1.03 mainly to
17             make error throwing uniform in all objects. There are many objects
18             currently not derived from Atom, but that will eventually change.
19              
20             All new XAO dynamic object should use Atom as their base if they are not
21             already based on dynamic object.
22              
23             =head1 METHODS
24              
25             =over
26              
27             =cut
28              
29             ###############################################################################
30             package XAO::DO::Atom;
31 3     3   21 use strict;
  3         7  
  3         107  
32 3     3   15 use XAO::Utils;
  3         6  
  3         175  
33 3     3   17 use XAO::Errors;
  3         6  
  3         38  
34              
35             ###############################################################################
36              
37             =item new (%)
38              
39             Generic new - just stores everything that it gets in a hash. Can be
40             overriden if an object uses something different then a hash as a base or
41             needs a different behavior.
42              
43             =cut
44              
45             sub new ($%) {
46 42     42 1 104 my $proto=shift;
47 42         119 my $self=merge_refs(get_args(\@_));
48 42   33     361 bless $self,ref($proto) || $proto;
49             }
50              
51             ###############################################################################
52              
53             =item objname
54              
55             Returns the shorthand objname that was passed to XAO::Objects->new()
56             when creating this object. It is not the same as the fully qualified
57             class name.
58              
59             =cut
60              
61             sub objname ($) {
62 24     24 1 467 return $_[0]->{'objname'};
63             }
64              
65             ###############################################################################
66              
67             =item throw ($)
68              
69             Helps to write code like:
70              
71             sub foobar ($%) {
72             my $self=shift;
73             my $args=get_args(\@_);
74              
75             my $id=$args->{id} || throw $self "foobar - no 'id' given";
76             ...
77             }
78              
79             It is recommended to always use text messages of the following format:
80              
81             "function_name - error description starting with a lowercase letter"
82             or
83             "- error description starting with a lowercase letter"
84             or
85             "(arg1,arg2) - error description"
86              
87             There is no need to print class name, it will be prepended to the front
88             of your error message automatically. If the message starts with '- ' or '('
89             then the function name is taken from the stack and added automatically
90             too.
91              
92             =cut
93              
94             sub throw ($@) {
95 4     4 1 587 my $self=shift;
96 4 50       21 my $text=join('',map { defined $_ ? $_ : '' } @_);
  4         33  
97              
98 4         20 my $class;
99 4 50 33     10 if(eval { $self->{'objname'} } && !$@) {
  4         29  
100 4         15 $class='XAO::DO::' . $self->{'objname'};
101             }
102             else {
103 0         0 $class=ref($self);
104             }
105              
106 4 100       45 if($text =~ /^\s*-\s+/) {
    100          
107 1         9 (my $fname=(caller(1))[3])=~s/^.*://;
108 1         4 $text=$fname . ' ' . $text;
109             }
110             elsif($text =~ /^\s*\(/) {
111 1         9 (my $fname=(caller(1))[3])=~s/^.*://;
112 1         4 $text=$fname . $text;
113             }
114              
115 4         134 $text.=" (file ".((caller(0))[1]).", line ".((caller(0))[2]).", called from ".((caller(1))[1]).", line ".((caller(1))[2]).")\n";
116              
117 4         52 XAO::Errors->throw_by_class($class,$text);
118             }
119              
120             ###############################################################################
121             1;
122             __END__