File Coverage

blib/lib/Class/ByOS.pm
Criterion Covered Total %
statement 19 19 100.0
branch 6 6 100.0
condition 2 3 66.6
subroutine 6 6 100.0
pod 2 3 66.6
total 35 37 94.5


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2009 -- leonerd@leonerd.org.uk
5              
6             package Class::ByOS;
7              
8 4     4   90451 use strict;
  4         11  
  4         156  
9 4     4   20 use warnings;
  4         7  
  4         133  
10 4     4   32 use base qw( Exporter );
  4         7  
  4         1684  
11              
12             our $VERSION = '0.02';
13              
14             our @EXPORT = qw( new );
15              
16             =head1 NAME
17              
18             C - write object classes that load OS-specific subclasses at runtime
19              
20             =head1 SYNOPSIS
21              
22             This module is for authors of object classes. A class might be written as
23              
24             package System::Wobble;
25              
26             use Class::ByOS;
27              
28             # NOT new()
29             sub __new
30             {
31             my $class = shift;
32             my @args = @_;
33             ...
34              
35             return bless { internals => here }, $class;
36             }
37              
38             sub wobble
39             {
40             # we'll just shell out to the 'wobble' binary
41             system( "wobble" );
42             }
43              
44             1;
45              
46             The user of this class doesn't need to know the details; it can be used like
47              
48             use System::Wobble;
49              
50             my $wobbler = System::Wobble->new();
51             $wobbler->wobble;
52              
53             An OS-specific implementation can be provided in a subclass
54              
55             package System::Wobble::wobblyos;
56              
57             use base qw( System::Wobble );
58              
59             use WobblyOS::Wobble qw( sys_wobble );
60              
61             sub wobble { sys_wobble() }
62              
63             1;
64              
65             =head1 DESCRIPTION
66              
67             Often a module will provide a general functionallity that in some way uses the
68             host system's facilities, but in a way that can either benefit from, or
69             requires an implementation specific to that host OS. Examples might be IO
70             system calls, access to networking or hardware devices, kernel state, or other
71             specific system internals.
72              
73             By implementing a base class using this module, a special constructor is
74             formed that, at runtime, probes the available modules, constructing an
75             instance of the most specific subclass that is appropriate. This allows the
76             object's methods, including its actual constructor, to be overridden for
77             particular OSes, in order to provide functionallity specifically to that OS,
78             without sacrificing the general nature of the base class.
79              
80             The end-user program that uses such a module does not need to be aware of this
81             magic. It simply constructs an object in the usual way by calling the class's
82             C method and use the object reference returned.
83              
84             =cut
85              
86             =head1 EXPORTED CONSTRUCTOR
87              
88             =cut
89              
90             =head2 $obj = $class->new( @args )
91              
92             By default, this module exports a C function into its importer, which
93             is the constructor actually called by the end-user code. This constructor will
94             determine the best subclass to use (see C), then invoke
95             the C<__new()> method on that class, passing in all its arguments.
96              
97             =cut
98              
99             # This is the EXPORTED new()
100             sub new
101             {
102 4     4 1 2427 find_best_subclass( shift )->__new( @_ );
103             }
104              
105             =head1 FUNCTIONS
106              
107             =cut
108              
109             =head2 $class = find_best_subclass( $baseclass )
110              
111             This function attempts to find suitable subclasses for the base class name
112             given. Candidates for being chosen will be
113              
114             =over 4
115              
116             =item C<$class::$^O>
117              
118             =item C<$class>
119              
120             For each candidate, it will be picked if that package provides a method called
121             C<__new>. If it does not exist yet, then an attempt will be made to load the
122             package using C. If this attempt succeeds and the C<__new> method now
123             exists, then the candidate will be picked.
124              
125             =back
126              
127             =cut
128              
129             sub find_best_subclass
130             {
131 4     4 1 10 my $class = shift;
132              
133 4 100       8 eval { try_class( "${class}::$^O" ) } or
  4         25  
134             # TODO: try OS families here; e.g. linux -> POSIX
135             $class;
136             }
137              
138             sub try_class
139             {
140 4     4 0 7 my $class = shift;
141              
142 4 100       64 $class->can( "__new" ) and return $class;
143              
144 3         22 ( my $path = "$class.pm" ) =~ s{::}{/}g;
145 3 100 66     9 eval { require $path } and $class->can( "__new" ) and return $class;
  3         1705  
146              
147 2         20 return undef;
148             }
149              
150             # Keep perl happy; keep Britain tidy
151             1;
152              
153             __END__