view release on metacpan or  search on metacpan

tkdm/tkdm  view on Meta::CPAN

		close_dsn ($label -> {host}, $label -> {dsn});
		last;
	    }

	    no warnings; # Avoid uninitialized value warnings from undefs.
	    if ($dsnlastselected != $label -> {text_id}) {
		$dsnpane -> itemconfigure ($label -> {text_id}, 
					   -font => $dsnselectedfont);
		$dsnpane -> itemconfigure ($dsnlastselected, 
					   -font => $dsnnormalfont);
		$dsnlastselected = $label -> {text_id};
		open_dsn ($label -> {host}, $label -> {dsn});
		last;
	    } else {
		$dsnpane -> itemconfigure ($label -> {text_id}, 
					   -font => $dsnnormalfont);
		$dsnlastselected = 0;
		last;
	    }
	    use warnings;
	}
    }
}

sub open_dsn {
    my ($host, $dsn) = @_;
    return if ((! length ($host)) || (! length ($dsn)));
    getdsnlogin ($host, $dsn);
}

sub close_dsn {
    my ($host, $dsn) = @_;
    return if ((! length ($host)) || (! length ($dsn)));
    my @tmplabels;
    foreach my $d (@hostlabels) {
	if (($d -> {host} =~ m"$host") && ($d -> {dsn} =~ m"$dsn")) {
	# Erase item from the canvas and don't save the table items.
	    if (length ($d -> {table})) {
		$dsnpane -> delete ($d -> {image_id});
		$dsnpane -> delete ($d -> {text_id});
		next;
	    } elsif ($d -> {connect_status} =~ m"$DSN_OPEN") {
		$d -> {login_name} = '';
		$d -> {password} = '';
		$d -> {connect_status} = '';
		push @tmplabels, ($d);
	    }
	} else {
	    push @tmplabels, ($d);
	}
    }
    $#hostlabels = -1;
    push @hostlabels, @tmplabels;
    drawdsnpane ($dsnpane);
}

sub getdsnlogin {
    my ($host, $dsn) = @_;
    my $dw = new MainWindow (-title => 'Log In');
    my $userlabel = $dw -> Label (-text => 'User Name: ') 
	-> grid (-row => 1, -column => 1, -columnspan => 2,
		 -padx => 5, -pady => 5);
    my $passwordlabel = $dw -> Label (-text => 'Password: ') 
	-> grid (-row => 2, -column => 1, -columnspan => 2,
		 -padx => 5, -pady => 5);
    my $userentry = $dw -> Entry (-textvariable => \$dsnloginusername)
	-> grid (-row => 1, -column => 3, -columnspan => 5,
		 -padx => 5, -pady => 5); 
    $dw -> Advertise ('userentry' => $userentry);
    my $passwordentry = $dw -> Entry (-textvariable => \$dsnloginpassword,
				      -show => '*')
	-> grid (-row => 2, -column => 3, -columnspan => 5,
		 -padx => 5, -pady => 5); 
    $dw -> Advertise ('passwordentry' => $passwordentry);
    my $loginbutton = 
	$dw -> Button ( -text => 'Log In',
	       -height => 1,
	       -width => 10,
	       -command => sub {tablelogin ($dw, $host, $dsn, 
					    $dsnloginusername, 
					    $dsnloginpassword) &&
						$dw -> WmDeleteWindow}) 
	    -> grid (-row => 3, -column => 1, -columnspan => 4,
		     -padx => 5, -pady => 5);
    my $cancelbutton = 
	$dw -> Button (-text => 'Cancel',
		       -height => 1,
		       -width => 10,
		       -command => sub {$dw -> WmDeleteWindow})
	    -> grid (-row => 3, -column => 5, -columnspan => 4,
		     -padx => 5, -pady => 5);
}

sub tablelogin {
    my ($dw, $peer, $dsn, $username, $password) = @_;
    my ($peerusername, $peerpassword) = split /::/, $peers{$peer};
    my ($evh, $cnh, $sth, $r, $text, $textlen);
    my (@tables, $tableobj, @tmpdsns);
    my $c = peer_client_login ($peer, $peerusername, $peerpassword);
    if ($c =~ m"$CLIENT_LOGIN_ERROR") {
	error_dialog ($dw, "Could not log in to remote host $peer.");
	return 1;
    }

    $evh =  $c -> sql_alloc_handle ($SQL_HANDLE_ENV, $SQL_NULL_HANDLE);
    if (defined $evh) { 
	$r = $c -> 
	    sql_set_env_attr ($evh, $SQL_ATTR_ODBC_VERSION, $SQL_OV_ODBC2, 0);
    } else {
	odbc_diag_message ($c, $SQL_HANDLE_ENV, $evh, 'tablelogin',
			    'sql_alloc_handle (evh)');
	return 1;
    }

    $cnh = $c -> sql_alloc_handle ($SQL_HANDLE_DBC, $evh);
    if (! defined $cnh) {
	odbc_diag_message ($c, $SQL_HANDLE_ENV, $evh, 'tablelogin',
			    'sql_alloc_handle (cnh)');
	return 1;
    }

    $r = $c -> sql_connect ($cnh, $dsn, length($dsn),
			$username, length($username), 
			$password, length($password));
    if ($r != $SQL_SUCCESS) {
	odbc_diag_message ($c, $SQL_HANDLE_DBC, $cnh, 
			   'tablelogin', 'sql_connect');
	return 1;
    }

    $sth = $c -> sql_alloc_handle ($SQL_HANDLE_STMT, $cnh);
    if (! defined $sth) {
	odbc_diag_message ($c, $SQL_HANDLE_DBC, $cnh,
			   'tablelogin', 'sql_alloc_handle (sth)');
	return 1;
    }

    $r = $c -> sql_tables ($sth, '', 0, '', 0, '', 0, '', 0);
    if ($r != $SQL_SUCCESS) {
	odbc_diag_message ($c, $SQL_HANDLE_STMT, $sth, 
			   'tablelogin', 'sql_tables');
	return 1;
    }

    while (1) {
	$r = $c -> sql_fetch ($sth);
	last if $r == $SQL_NO_DATA;
	($r, $text, $textlen) = 
	    $c -> sql_get_data ($sth, 3, $SQL_C_CHAR, 255);
	if ($r != $SQL_SUCCESS) {

tkdm/tkdm  view on Meta::CPAN

				      $insert_y_org, 
				      -image => $dsnpixmap,
				      -anchor => 'nw');
	    
	    $label -> {text_id} = 
		$pane -> 
		    createText ($dsn_indent + $dsnxpmwidth + $imagepadding, 
				$insert_y_org, 
				-text => $label -> {dsn}, 
				-anchor => 'nw');
	    $label_length = 
		($normalfontmetric -> measure ($label -> {dsn})) +
					   $dsnxpmwidth +
					   $imagepadding;
						       
	    $x_width = $label_length if $label_length > $x_width;
	    $label -> {x_org} = $dsn_indent;
	    $label -> {y_org} = $insert_y_org;
	    $label -> {x_bound} = $dsn_indent + $label_length;
	    $label -> {y_bound} = $insert_y_org + $dsnxpmheight;
	    $insert_y_org += $imagepadding + $dsnxpmheight;
	} else { # Draw the host label
	    local $image;
	    if ($label -> {connect_status} =~ m"$HOST_NOT_CONNECTED") {
		$image = $notermpixmap;
	    } else {
		$image = $termpixmap;
	    }
	    $label -> {image_id} = 
		$pane -> createImage ($host_indent, 
				      $insert_y_org, 
				      -image => $image,
				      -anchor => 'nw');
	    $label -> {text_id} = $pane -> 
		createText ($host_indent + $termxpmwidth + $imagepadding, 
			    $insert_y_org, 
			    -text => $label -> {host}, 
			    -anchor => 'nw');
	    $label_length = 
		($normalfontmetric -> measure ($label -> {host})) +
					   $termxpmwidth +
					   $imagepadding;
						       
	    $x_width = $label_length if $label_length > $x_width;
	    $label -> {x_org} = $host_indent;
	    $label -> {y_org} = $insert_y_org;
	    $label -> {x_bound} = $host_indent + $label_length;
	    $label -> {y_bound} = $insert_y_org + $termxpmheight;
	    $insert_y_org += $imagepadding + $termxpmheight;
	}
    } # foreach my $label (@hostlabels)
    $dsnpane -> configure (-scrollregion =>
			   [0,0, $x_width, $insert_y_org]);
}

sub execute_text_query {
    my ($labelptr) = @_;
    my $qdialog = 
	new MainWindow ( -title => 'SQL Query');
    my $qtextbox = new_textbox ($qdialog, -height => 15, -width => 60);
    $qtextbox -> grid (-row => 1, -column => 1, -columnspan => 2);
    $qtextbox -> insert ('end', $userquerytext);
    $qdialog -> Advertise ('qtextbox' => $qtextbox);

    my $acceptbutton => $qdialog -> Button (-text => 'Submit',
               -height => 1, -width => 10,
               -command => sub {sql_query ($qdialog, $labelptr)},
               @stdargs) -> 
        grid (-row => 2, -column => 1, -pady => 10);
    my $dismissbutton => $qdialog -> Button (-text => 'Dismiss',
               -height => 1, -width => 10,
               -command => sub {$qdialog -> WmDeleteWindow},
               @stdargs) -> 
       grid (-row => 2, -column => 2, -pady => 10);
}

sub sql_query {
    my ($w, $labelptr) = @_;
    $mw -> Busy;
    my @col_selectors;
    $userquerytext = 
	$labelptr -> {query} = 
	$w -> Subwidget ('qtextbox') -> get ('0.0', 'end');
    $labelptr -> {query} =~ s/\n/ /gsm;
    print 'sql_query: ' . $labelptr -> {query} . "\n" if $debug;
    for my $k (keys %{$tablepane -> {SubWidget}}) {
	if ($k =~ /cb_/) {
	    push @col_selectors, ($tablepane -> Subwidget ($k));
	}
    }
    push @{$labelptr -> {columns}}, @col_selectors;
    my $resultarrayref = query_db ($labelptr);
    display_result_set ($labelptr, $resultarrayref);
    $w -> WmDeleteWindow;
    $mw -> Unbusy;
}

sub execute_select_query {
    my ($labelptr) = @_;
    $mw -> Busy;
    my (@col_selectors, @predicates); # Refs of the check button and
                                      # entry widgets at the top of
                                      # the frame.
    # (Re-)initialize some data.
    $#col_selectors = -1;
    $#predicates = -1;
    my ($query, $tmplabel, $resultarrayref);
    for my $k (keys %{$tablepane -> {SubWidget}}) {
	if ($k =~ /cb_/) {
	    push @col_selectors, ($tablepane -> Subwidget ($k));
	    ($tmplabel) = ($k =~ /cb_(.*)/);
	    push @predicates, ($tablepane -> Subwidget ("en_$tmplabel"));
	}
    }
    $labelptr -> {query} = 
	build_select_query ($labelptr, \@col_selectors, \@predicates);
    $resultarrayref = query_db ($labelptr);
    display_result_set ($labelptr, $resultarrayref);
    $mw -> Unbusy;
}