File Coverage

blib/lib/Win32/SqlServer/DTS.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1             package Win32::SqlServer::DTS;
2            
3             =head1 NAME
4            
5             Win32::SqlServer::DTS - Perl classes to access Microsoft SQL Server 2000 DTS Packages
6            
7             =head1 DESCRIPTION
8            
9             Although it's possible to use all features here by using only C module, C (being more specific, it's
10             childs classes) provides a much easier interface (pure Perl) and (hopefully) a better documentation.
11            
12             The API for this class will give only read access to a package attributes. No write methods are available are
13             directly available at this time, but could be executed since at each DTS object created a related object is
14             passed as an reference to new object. This related object is a MS SQL Server DTS object and has all methods and
15             properties as defined by the MS API. This object reference is kept as an "private" property called C<_sibling>
16             and generally can be obtained with a C method call. Once the reference is recovered, all methods from it
17             are available.
18            
19             The C class does not much: it will server only as an interface class, since it cannot be instancied or the
20             available methods be called directly (as an abstracted class). The inheritance will help only to make available
21             easier (and globally) access to the methods C and C.
22            
23             =head2 Why having all this trouble?
24            
25             You may be asking yourself why having all this trouble to write such API as an layer to access data thought C
26             module.
27            
28             The very simple reason is: MS SQL Server 2000 API is terrible to work with (lots and lots of indirection), the
29             documentation is not as good as it should be and one has to convert examples from it of VBScript code to Perl.
30            
31             C API was created to provide an easier (and more "perlish") way to fetch data from a DTS package.
32             One can use this API to easily create reports or implement automatic tests using a module
33             as L (see EXAMPLES directory in the tarball distribution of this module).
34            
35             Current development state should be considered BETA, despite the API is already usable. There is a high chance that the
36             interface changes during next releases, so be careful when updating.
37            
38             =head2 EXPORT
39            
40             Nothing.
41            
42             =cut
43            
44 12     12   10793 use strict;
  12         25  
  12         557  
45 12     12   95 use warnings;
  12         26  
  12         335  
46 12     12   16785 use Data::Dumper;
  12         168680  
  12         1011  
47 12     12   155 use Carp qw(confess);
  12         24  
  12         647  
48 12     12   11248 use Devel::AssertOS qw(MSWin32);
  12         33080  
  12         181  
49            
50             our $VERSION = '0.10';
51            
52             =head2 METHODS
53            
54             =head3 get_sibling
55            
56             Returns the relationed DTS object. All objects holds an reference to the original DTS object once is instantiated,
57             unless the C is executed.
58            
59             If the reference is not available, it will abort program execution with an error.
60            
61             =cut
62            
63             sub get_sibling {
64            
65             my $self = shift;
66            
67             if ( exists( $self->{_sibling} ) ) {
68            
69             return $self->{_sibling};
70            
71             }
72             else {
73            
74             confess
75             "The reference to the original DTS object is not more available\n";
76            
77             }
78            
79             }
80            
81             =head3 is_sibling_ok
82            
83             Validates if the attribute _sibling is defined and has a valid value. Returns true if it's ok, false otherwise.
84            
85             =cut
86            
87             sub is_sibling_ok {
88            
89             my $self = shift;
90            
91             if ( ( exists( $self->{_sibling} ) )
92             and ( $self->{_sibling}->isa('Win32::OLE') ) )
93             {
94            
95             return 1;
96            
97             }
98             else {
99            
100             return 0;
101            
102             }
103            
104             }
105            
106             =head3 kill_sibling
107            
108             This method will simple delete the key (or attribute, if you prefer) C<_sibling> from the hash reference used by all classes that inherints from
109             DTS class. Once the key is removed, the Perl garbage collector will remove the related object created using the MS SQL
110             Server 2000.
111            
112             The reasons of why doing such thing is described in L.
113            
114             =cut
115            
116             sub kill_sibling {
117            
118             my $self = shift;
119             delete $self->{_sibling};
120            
121             }
122            
123             =head3 debug
124            
125             Uses the L C function to print to C the properties of a given object
126             that inherints from C (almost of all classes in the API).
127            
128             The way this is implemented is to do a dirty I of the original object, but without the C<_sibling>
129             attribute. This allows to quickly check the object state. This is not as good as it could be, but sometimes
130             the Perl debugger dies while checking DTS objects, so it's better than nothing.
131            
132             Maybe in the future this method is replaced to turn on debug mode for all methods calls using C module.
133            
134             =cut
135            
136             sub debug {
137            
138             my $self = shift;
139             my $clone;
140            
141             foreach my $key ( keys( %{$self} ) ) {
142            
143             next if ( $key eq '_sibling' );
144            
145             $clone->{$key} = $self->{$key};
146            
147             }
148            
149             bless $clone, ref($self);
150            
151             print Dumper($clone);
152            
153             }
154            
155             1;
156             __END__