home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / ddl.pl < prev    next >
Encoding:
Perl Script  |  2002-05-21  |  3.5 KB  |  146 lines
  1. #! /usr/bin/perl -w
  2.  
  3. # $Id: Ddl.pl,v 1.13 2001/04/28 13:50:25 rvsutherland Exp $
  4.  
  5. use strict;
  6.  
  7. use DBI;
  8. use DDL::Oracle;
  9. use English;
  10.  
  11. my  $dbh = DBI->connect(
  12.                         "dbi:Oracle:",
  13.                         "",
  14.                         "",
  15.                         {
  16.                          PrintError => 0,
  17.                          RaiseError => 1
  18.                         }
  19.     );
  20.  
  21. DDL::Oracle->configure( 
  22.                         dbh      => $dbh,
  23.                         resize   => 1,
  24. #                        view     => 'user',
  25. #                        heading  => 0,
  26. #                        prompt   => 0,
  27.                       );
  28.  
  29. my $user = getlogin
  30.         || scalar getpwuid($REAL_USER_ID)
  31.         || undef;
  32.  
  33. print STDERR "Enter Action [CREATE]: ";
  34. chomp( my $action = <STDIN> );
  35. $action = "create" unless $action;
  36.  
  37. print STDERR "Enter Type    [TABLE]: ";
  38. chomp( my $type = <STDIN> );
  39. $type = "TABLE" unless $type;
  40.  
  41. print STDERR "Enter Owner [\U$user]: ";
  42. chomp( my $owner = <STDIN> );
  43. $owner = $user unless $owner;
  44. die "\nYou must specify an Owner.\n" unless $owner;
  45.  
  46. print STDERR "Enter Name           : ";
  47. chomp( my $name = <STDIN> );
  48. die "\nYou must specify an object.\n"
  49.    unless (
  50.                 $name
  51.              or "\U$type" eq 'COMPONENTS'
  52.              or "\U$type" eq 'SCHEMA'
  53.           );
  54.  
  55. print STDERR "\n";
  56.  
  57. my $obj = DDL::Oracle->new(
  58.                             type  => $type,
  59.                             list  => [
  60.                                        [
  61.                                          $owner,
  62.                                          $name,
  63.                                        ]
  64.                                      ]
  65.                           );
  66.  
  67. my $sql;
  68.  
  69. if ( $action eq "drop" ){
  70.     $sql = $obj->drop;
  71. }
  72. elsif ( $action eq "create" ){
  73.     $sql = $obj->create;
  74. }
  75. elsif ( $action eq "resize" ){
  76.     $sql = $obj->resize;
  77. }
  78. elsif ( $action eq "compile" ){
  79.     $sql = $obj->compile;
  80. }
  81. elsif ( $action eq "show_space" ){
  82.     $sql = $obj->show_space;
  83. }
  84. else{
  85.     die "\n$0 doesn't know how to '$action'.\n";
  86. } ;
  87.  
  88. print $sql;
  89.  
  90. # $Log: Ddl.pl,v $
  91. # Revision 1.13  2001/04/28 13:50:25  rvsutherland
  92. # Modified to facilitate the new type 'schema'.
  93. #
  94. # Revision 1.12  2001/03/31 18:27:42  rvsutherland
  95. # Facilitated new object type 'components', which requires neither
  96. # name nor owner.
  97. #
  98. # Revision 1.11  2001/03/20 01:49:51  rvsutherland
  99. # Facilitated instance method 'show_space'
  100. #
  101. # Revision 1.10  2001/03/03 18:41:31  rvsutherland
  102. # Added DESCRIPTION to pod.
  103. #
  104. # Revision 1.9  2001/01/27 16:21:44  rvsutherland
  105. # Added NAME section to pod.
  106. #
  107. # Revision 1.8  2001/01/14 16:47:55  rvsutherland
  108. # Nominal changes for version 0.32
  109. #
  110. # Revision 1.7  2001/01/07 16:43:56  rvsutherland
  111. # Added COPYRIGHT
  112. #
  113. # Revision 1.6  2001/01/06 16:21:15  rvsutherland
  114. # Facilitated 'compile' method
  115. #
  116. # Revision 1.5  2000/12/09 17:55:20  rvsutherland
  117. # Re-added after CVS bug fixed.
  118. #
  119. # Revision 1.3  2000/11/11 07:48:59  rvsutherland
  120. # Added CVS tags
  121. #
  122.  
  123. =head1 NAME
  124.  
  125. ddl.pl - Generates DDL for a single, named object
  126.  
  127. =head1 DESCRIPTION
  128.  
  129. Calls DDL::Oracle for the DDL of a specified object.
  130.  
  131. =head1 AUTHOR
  132.  
  133.  Richard V. Sutherland
  134.  rvsutherland@yahoo.com
  135.  
  136. =head1 COPYRIGHT
  137.  
  138. Copyright (c) 2000, 2001 Richard V. Sutherland.  All rights reserved.
  139. This module is free software.  It may be used, redistributed, and/or
  140. modified under the same terms as Perl itself.  See:
  141.  
  142.     http://www.perl.com/perl/misc/Artistic.html
  143.  
  144. =cut
  145.  
  146.