File Coverage

blib/lib/Win32/SqlServer/DTS/Connection.pm

Criterion	Covered	Total	%
statement	12	12	100.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	16	16	100.0

package Win32::SqlServer::DTS::Connection;

=head1 NAME

Win32::SqlServer::DTS::Connection - a Perl class to represent a Microsoft SQL Server 2000 DTS Connection object

=head1 SYNOPSIS

    use Win32::SqlServer::DTS::Application;

    my $app = Win32::SqlServer::DTS::Application->new(
        {
            server                 => $server,
            user                   => $user,
            password               => $password,
            use_trusted_connection => 0
        }
    );

    my $package = $app->get_db_package(
        { id => '', version_id => '', name => 'some_package', package_password => '' } );

    my $iterator = $package->get_connections();

    while ( my $conn = $iterator->() ) {

        print $conn->get_name(), "\n";

    }

    # or if you have $connection as a regular
    # MS SQL Server Connection object

    my $conn2 = Win32::SqlServer::DTS::Connection->new($connection);
    print $conn2->to_string(), "\n";

=head1 DESCRIPTION

C class represent a DTS Connection object, serving as a layer to fetch properties
from the DTS Connection stored in the C<_sibling> attribute.

Although it's possible to create an C object directly (once a DTS Connection object is available), one
will probably fetch connections from a package using the C method from the L
module.

=head2 EXPORT

None by default.

=cut

use strict;
use warnings;
use Carp;
use base qw(Class::Accessor Win32::SqlServer::DTS);
use Win32::OLE qw(in);
use Hash::Util qw(lock_keys);

__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_ro_accessors(
    qw(oledb catalog datasource description id name password provider user));

=head2 METHODS

Inherints all methods from L superclass.

=head3 new

The only expected parameter to the C method is an already available DTS Connection object. Returns a
C object.

=cut

sub new {

    my $class = shift;
    my $self = { _sibling => shift };

    bless $self, $class;

    my $sibling = $self->get_sibling;

    $self->{catalog}     = $sibling->Catalog;
    $self->{datasource}  = $sibling->DataSource;
    $self->{description} = $sibling->Description;
    $self->{id}          = $sibling->ID;
    $self->{name}        = $sibling->Name;
    $self->{password}    = $sibling->Password;
    $self->{provider}    = $sibling->ProviderID;
    $self->{user}        = $sibling->UserID;

    $self->{oledb} = $self->_init_oledb_props;

    lock_keys( %{$self} );

    return $self;

}

=head3 get_type

Fetchs the I value of the connection. It is an alias for the C method.

=cut

sub get_type {

    my $self = shift;
    return $self->get_provider();

}

sub _init_oledb_props {

    my $self = shift;
    my %props;

    foreach my $property ( in( $self->get_sibling->ConnectionProperties ) ) {

        my $key = $property->Name;
        $key =~ tr/ //d;

        $props{$key} = {
            name         => $property->Name,
            property_id  => $property->PropertyID,
            property_set => $property->PropertySet,
            value => ( defined( $property->Value ) ) ? $property->Value : ''
        };

    }

    # converting numeric code to string
    if ( exists( $props{FileType} ) ) {

      CASE: {

            if ( $props{FileType}->{value} == 2 ) {

                $props{FileType}->{value} = 'UTF';
                last CASE;

            }

            if ( $props{FileType}->{value} == 1 ) {

                $props{FileType}->{value} = 'ASCII';
                last CASE;

            }

            if ( $props{FileType}->{value} == 4 ) {

                $props{FileType}->{value} = 'OEM';
                last CASE;

            }

        }

    }

    return \%props;

}

=head3 to_string

Returns a string with all properties (but those returned by C method) from the a C
object. Each property will have a short description before the value and will be separated by new line characters.

=cut

sub to_string {

    my $self = shift;

    my $string =
        "\tName: "
      . $self->get_name
      . "\n\tDescription: "
      . $self->get_description
      . "\n\tID: "
      . $self->get_id
      . "\n\tCatalog: "
      . $self->get_catalog
      . "\n\tData Source: "
      . $self->get_datasource
      . "\n\tUser: "
      . $self->get_user
      . "\n\tPassword: "
      . $self->get_password
      . "\n\tProvider: "
      . $self->get_provider;

    return $string;

}

1;
__END__