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 13     13   19349 use strict;
  13         19  
  13         392  
45 13     13   104 use warnings;
  13         17  
  13         255  
46 13     13   7497 use Data::Dumper;
  13         90829  
  13         936  
47 13     13   161 use Carp qw(confess);
  13         16  
  13         645  
48 13     13   5472 use Devel::AssertOS qw(MSWin32);
  13         19163  
  13         69  
49              
50             our $VERSION = '0.12';
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__