Win32::SqlServer::DTS::Application - a Perl class to emulate Microsoft SQL Server 2000 DTS Application object

Win32-SqlServer-DTS documentation Contained in the Win32-SqlServer-DTS distribution.

Index

Code Index:

NAME

Top

Win32::SqlServer::DTS::Application - a Perl class to emulate Microsoft SQL Server 2000 DTS Application object

SYNOPSIS

Top

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

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

    # fetchs a list of packages
    my @list = qw( LoadData ChangeData ExportData);

    foreach my $name ( @list ) {

        my $package = $self->get_db_package( { name => $name } ) );
        print $package->to_string;

    }

DESCRIPTION

Top

This Perl class represents the Application object from the MS SQL Server 2000 API. Before fetching any package from a server one must instantiate a Win32::SqlServer::DTS::Application object that will provide methods to fetch packages without having to provide autentication each time.

EXPORT

None by default.

METHODS

new

Instantiate a new object from Win32::SqlServer::DTS::Application class. The expected parameter is a hash reference with the following keys:

* server: the name of a database server already configured in the Enterprise Manager.
* user: a string of the user used to authenticate against the database server. Not necessary to specify if use_trusted_connection is true.
* password: a string of the password used to authenticate against the database server. Not necessary to specify if use_trusted_connection is true.
* use_trusted_connection: a true/false value (1 or 0, respectivally) to specify if a Trusted Connection will be the authentication method to be used.

See SYNOPSIS for an example.

get_db_package

Fetchs a single package from a MS SQL server and returns a respective Win32::SqlServer::DTS::Package object. Expects a hash reference as a parameter, having the following keys defined:

* id: the uniq package ID. Obligatory if a package name is not provided.
* version_id: the version ID of the package. If not provided, the last version of the package will be fetched.
* name: the name of the package. Obligatory if a package id is not provided.
* package_password: the password used to restrict access to the package. Not obligatory if no password is used.

get_db_package_regex

Expect an regular expression as a parameter. The regular expression is case sensitive.

Returns a Win32::SqlServer::DTS::Package object which name matches the regular expression passed as an argument. Only one object is returned (the first one in a sorted list) even if there are more packages names that matches.

regex_pkgs_names

Expect an string, as regular expression, as a parameter. The parameter is case insensitive and the string is compiled internally in the method, so there is not need to use qr (qr) or something like that to increase performance.

Returns an array reference with all the packages names that matched the regular expression passed as an argument.

list_pkgs_names

Returns an array reference with all the packages names available in the database of the MS SQL Server. The items in the array are sorted for convenience.

CAVEATS

Top

Several methods from MS SQL Server DTS Application class were not implemented, specially those available in PackageSQLServer and PackageRepository classes.

SEE ALSO

Top

* Win32::OLE at perldoc.
* MSDN on Microsoft website and MS SQL Server 2000 Books Online are a reference about using DTS' object hierarchy, but one will need to convert examples written in VBScript to Perl code.

AUTHOR

Top

Alceu Rodrigues de Freitas Junior, <arfreitas@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright (C) 2006 by Alceu Rodrigues de Freitas Junior

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available.

Win32-SqlServer-DTS documentation Contained in the Win32-SqlServer-DTS distribution. 
package Win32::SqlServer::DTS::Application;


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

our $VERSION = '0.03';

__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_ro_accessors(qw(credential));


sub new {

    my $class      = shift;
    my $properties = shift;

    confess "expects an hash reference as a parameter"
      unless ( ref($properties) eq 'HASH' );

    my $self;

    $self->{credential} = Win32::SqlServer::DTS::Credential->new($properties);

    $self->{_sibling} = Win32::OLE->new('DTS.Application');

    bless $self, $class;
    lock_keys( %{$self} );
    return $self;

}


sub get_db_package {

    my $self        = shift;
    my $options_ref = shift;

    # validates if the parameters are valid
    confess "Package name or ID must be informed\n"
      unless (
        (
                ( exists( $options_ref->{id} ) )
            and ( defined( $options_ref->{id} ) )
        )
        or (    ( exists( $options_ref->{name} ) )
            and ( defined( $options_ref->{name} ) ) )
      );

    $options_ref->{id}   = '' unless ( defined( $options_ref->{id} ) );
    $options_ref->{name} = '' unless ( defined( $options_ref->{name} ) );

    foreach my $attribute (qw(package_password version_id)) {

        $options_ref->{$attribute} = ''
          unless (
            (
                exists( $options_ref->{$attribute} )
                and ( defined( $options_ref->{$attribute} ) )
            )
          );

    }

    my $sql_package = Win32::OLE->new('DTS.Package2');

    my ( $server, $user, $password, $auth_code ) =
      $self->get_credential->to_list;

  #the last parameter is not even available for use, but the DTS API demands it:
    $sql_package->LoadFromSQLServer(
        $server,                          $user,
        $password,                        $auth_code,
        $options_ref->{package_password}, $options_ref->{id},
        $options_ref->{version_id},       $options_ref->{name},
        ''
    );

    confess "Could not fetch package information: "
      . Win32::OLE->LastError() . "\n"
      if ( Win32::OLE->LastError() );

    return Win32::SqlServer::DTS::Package->new($sql_package);

}


sub get_db_package_regex {

    my $self  = shift;
    my $regex = shift;

    my $package_name = @{ $self->regex_pkgs_names($regex) }[0];

    unless ( defined($package_name) ) {

        cluck "Could not find any package with regex like $regex";
        return undef;

    }
    else {

        return $self->get_db_package( { name => $package_name } );

    }

}


sub regex_pkgs_names {

    my $self  = shift;
    my $regex = shift;

    my $list_ref = $self->list_pkgs_names();
    my @new_list;

    my $compiled_regex = qr/$regex/i;

    foreach my $name ( @{$list_ref} ) {

        push( @new_list, $name ) if ( $name =~ $compiled_regex );

    }

    return \@new_list;

}


sub list_pkgs_names {

    my $self = shift;

    my $sql_pkg =
      $self->get_sibling()
      ->GetPackageSQLServer( $self->get_credential->to_list() );

    confess "Could not connect to server: ", Win32::OLE->LastError(), "\n"
      if ( Win32::OLE->LastError() );

    my @list;

    foreach my $pkg_info ( in( $sql_pkg->EnumPackageInfos( '', 1, '' ) ) ) {

        push( @list, $pkg_info->Name );

    }

    @list = sort(@list);

    return \@list;

}

1;

__END__