use warnings; use strict; use DTS::Application; use Test::More; use XML::Simple; use DTS::Package; my $xml = XML::Simple->new(); my $config = $xml->XMLin('test-config.xml'); my $app = DTS::Application->new( $config->{credential} ); my $package = $app->get_db_package( { id => '', version_id => '', name => $config->{package}, package_password => '' } ); plan tests => $package->count_connections; my $conns_ref = fetch_conns( $package->get_connections ); my $dyn_props_ref = $package->get_dynamic_props; foreach my $dyn_prop ( @{$dyn_props_ref} ) { # get_properties returns a array reference, not an object foreach my $assignment_properties ( @{$dyn_prop->get_properties} ) + { if ( $assignment_properties->{type} eq 'INI' ) { my @destination = $assignment_properties->{destination}; if ( $destination[0] eq 'Connections' ) { if ( exists( $conns_ref->{ $destination[1] } ) ) { if ( $conns_ref->{ $destination[1] }->[0] eq 'SQLO +LEDB' ) { CASE: { if ( $destination[3] eq 'Catalog' ) { $conns_ref->{ $destination[1] }->[2] ->{catalog} = 1; last CASE; } if ( $destination[3] eq 'DataSource' ) { $conns_ref->{ $destination[1] }->[2] ->{datasource} = 1; last CASE; } if ( $destination[3] eq 'UserID' ) { $conns_ref->{ $destination[1] }->[2]-> +{userid} = 1; last CASE; } if ( $destination[3] eq 'Password' ) { $conns_ref->{ $destination[1] }->[2] ->{password} = 1; last CASE; } } #expected to be only text file datasource } else { if ( $destination[3] eq 'DataSource' ) { $conns_ref->{ $destination[1] }->[1] = 1; } } } } } } } foreach my $conn ( keys %{$conns_ref} ) { if ( $conns_ref->{$conn}->[0] eq 'SQLOLEDB' ) { map { $conns_ref->{$conn}->[1] += $_ } values( %{ $conns_ref->{$conn}->[2] } ); # if does not summs 4, something is missing ( $conns_ref->{$conn}->[1] == 4 ) ? ( $conns_ref->{$conn}->[1] = 1 ) : ( $conns_ref->{$conn}->[1] = 0 ); # else must be DTSFlatFile type } ok( $conns_ref->{$conn}->[1], "Connection \"$conn\" automatic configuration by INI reading" +); } sub fetch_conns { my $connections_ref = shift; my %conns; foreach my $conn ( @{$connections_ref} ) { # array reference holds connection type and boolean value indication c +onfiguration or not $conns{ $conn->get_name } = [ $conn->get_provider, 0 ]; # the connection type below must have four values configured by I +NI reading # index 1 will still hold boolean value if ( $conns{ $conn->get_name }->[0] eq 'SQLOLEBD' ) { $conns{ $conn->get_name }->[2] = { userid => 0, password => 0, datasource => 0, catalog = +> 0 } } } return \%conns; }
The debugger dies when the method get_properties is invoked. As I said before, this error is not especific to this code. Looks like this issue happens depending on the amount of objects the program uses simultaneously.
Here is more code regarding the get_properties method:
sub get_properties { my $self = shift; my $assignments = $self->get_sibling->Assignments; my @items; if ( defined($assignments) ) { foreach my $assignment ( in($assignments) ) { push( @items, DTS::AssignmentFactory->create($assignment)->get_prope +rties ); } return \@items; } else { carp "This dynamic properties does not have any assignment\n"; return []; } }
The get_sibling method returns a DynamicPropertiesTask object, as specified in the MS SQL 8 DTS documentation. For each assignment fetched with the in function, a new object is instantied.
I could try to create a iterator instead creating all assignments objects at once in the get_properties method, but this should be a performance enhancement, not a bug fix IMHO.
I tried running the program using the debugger again just to be sure. A nice (?) window asking me to report the error to Microsoft is opened. The only useful information I could find in the details is the information below:
AppName: perl.exe AppVer: 5.8.8.819 ModName: ole.dll ModVer: 0.0.0.0 Offset: 00001f98
I never tried Win32::OLE to do more than writing some stuff in a MS Word document, so I cannot say this is an issue caused by Win32::OLE plus DTS API or only the Win32::OLE itself.
In reply to Re^2: Win32::OLE and Perl debugger issue
by glasswalk3r
in thread Win32::OLE and Perl debugger issue
by glasswalk3r
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |