I use Oracle, and Toad (An Oracle development tool).

Last couple of days, I was involved in testing my code, it is basically Oracle + Pro * c. I decided that it was a good idea to write some test tools to help the testers, and I also decided ;-) Perl was the best choice.

The effort that I can spend on those tools was so limited, so I tried to avoid database coding in Perl, instead I used toad to do all the database operations. Now
  1. Toad can post query results to clipboard, and obviously toad support the basic paste operation as any other window gears.
  2. Perl has no problem to read/write clipboard thru Win32::Clipboard.
So, I just use the clipboard to communicate between toad and my Perl program, of course I would have to click buttons to copy and paste, but this does make the rapid development Perl provided more rapid ;-)

I am thinking this idea might be useful to others, under certain circumstance, so here is this post, and below is one of those little tools:
use Win32::Clipboard; use Net::FTP; use strict; #those files being processed are on AIX, where Oracle resides, so I fi +rst ftp them to my PC, where this script runs and toad runs ftp_order_file($ARGV[0]); #now read the file into this script, and it would be compared with ind +o in database. my $original_orders = read_order_file($ARGV[0]); #a sql query is formed based on the content of ftp'd files, and it is +then posted to clipboard post_order_query($original_orders); #I would now go to toad, paste the query in clipboard to toad editor, +and execute the query. The returned query result would be sent to cli +pboard. After the result is posted, I would come back, and hit enter, + so the script would continue... print "Hit enter to continue ...\n"; <STDIN>; #the query result is parsed my $database_orders = get_query_result(); #compare the two versions of facts, to see whether the info in the fil +es are loaded correctly. diff($original_orders, $database_orders); #this forms a query base on the error log created by my Oracle/Pro*c a +pplication, and check whether what described in that log matches the +real situation in database. post_asos_query($ARGV[0]); sub post_asos_query { my $order_file = shift; open(LOG, "<", "$order_file.log"); my @log_lines = <LOG>; close(LOG); my $query = "select * from dcs3000.stor_auth_pref\n" . "where bitm_numb_dpac in (%s)\n" . "and orgu_numb_rpnt =\n" . "(select orgu_numb from dcs3000.orgu\n" . "where sysdate between date_eff and date_inac\n" . "and user_intf_numb = %s)\n" . "and sysdate between date_eff and date_inac"; my $start = 0; my $no_asos = {}; foreach my $log_line (@log_lines) { chomp $log_line; if (substr($log_line, 0, 1) eq "-") { $start = 1; } else { if ($start) { if (!length($log_line)) { $start = 0; } else { my $item = substr($log_line, 61, 20); $item =~ s/ //g; my $store = substr($log_line, 95, 8); $store =~ s/ //g; push @{$no_asos->{$store}}, $item; } } } } my @queries; foreach my $store (keys %{$no_asos}) { push @queries, sprintf($query, join(",", @{$no_asos->{$store}} +), $store); } my $real_query = join(" union ", @queries); my $clip = Win32::Clipboard(); $clip->Set($real_query); } sub diff { my ($origin, $database) = @_; my $times; open(DIFF, ">", "$ARGV[0].diff"); foreach my $order (sort keys %{$origin}) { foreach my $item (sort keys %{$origin->{$order}}) { if (defined($database->{$order}->{$item})) { if (!defined($times)) { $times = $database->{$order}->{$item} / $origin->{ +$order}->{$item}; print "this order file has been loaded $times time +s\n"; } if ($origin->{$order}->{$item} != ($database->{$order} +->{$item} / $times)) { print "order = $order, item = $item, origin = $ori +gin->{$order}->{$item}, database = $database->{$order}->{$item} / $ti +mes\n"; print DIFF "order = $order, item = $item, origin = + $origin->{$order}->{$item}, database = $database->{$order}->{$item} +/ $times\n"; } } else { print "order = $order, item = $item, origin = $origin- +>{$order}->{$item}, database = undef\n"; print DIFF "order = $order, item = $item, origin = $or +igin->{$order}->{$item}, database = undef\n"; } } } close(DIFF); } sub ftp_order_file { my $order_file = shift; my $ftp = new Net::FTP("ofgaix2") || die "fail"; $ftp->login("aseries", "aseries2"); $ftp->cwd("/aa/a00/rel2.4/env/AATS1/GlomOrders"); $ftp->get($order_file); $ftp->get("$order_file.log"); $ftp->close(); } sub read_order_file { my $order_file = shift; open(ORDER, "<", "$order_file"); my @lines = <ORDER>; close(ORDER); my $original_orders = {}; for (my $line_numb = 1; $line_numb <= $#lines; $line_numb ++) { if (length($lines[$line_numb]) > 60) { my $order = substr($lines[$line_numb], 47, 8); my $item = substr($lines[$line_numb], 158, 10); $item =~ s/ //g; my $quantity = substr($lines[$line_numb], 180, 13); $original_orders->{$order}->{$item} += $quantity; } } return $original_orders; } sub post_order_query { my $original_orders = shift; my $clip = Win32::Clipboard(); my $order_query = "select h.extl_ordr_id, d.olin_numb, d.bitm_numb +, d.ordq_orig, d.ordq_crnt\n" . "from dcs3000.oom_ordr_hdr h, dcs3000.oom_olin d +\n" . "where h.extl_ordr_id in (%s)\n" . "and h.ordr_numb = d.ordr_numb\n" . "and d.time_row_crtn > sysdate - 2\n" . "order by h.ordr_numb desc"; my $real_order_query = sprintf($order_query, "\'" . join("\',\'", +keys %{$original_orders}) . "\'"); $clip->Set($real_order_query); } sub get_query_result { my $clip = Win32::Clipboard(); my $dump = $clip->Get(); my @database_lines = split "\r\n", $dump; my $splited = []; my $database_orders = {}; for (my $line_numb = 1; $line_numb <= $#database_lines; $line_numb + ++) { my @s = split(",", $database_lines[$line_numb]); push @{$splited}, \@s; $database_orders->{$s[0]}->{$s[2]} += $s[4]; } return $database_orders; }

In reply to Use Perl with toad by pg

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.