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 / copy_user.pl < prev    next >
Encoding:
Perl Script  |  2001-04-28  |  3.2 KB  |  133 lines
  1. #! /usr/bin/perl -w
  2.  
  3. # $Id: copy_user.pl,v 1.8 2001/04/28 13:49:32 rvsutherland Exp $
  4.  
  5. use strict;
  6.  
  7. use DBI;
  8. use DDL::Oracle;
  9.  
  10. my $obj;
  11. my $ddl;
  12. my $old_sql;
  13. my $new_sql;
  14. my $old_user;
  15. my $new_user;
  16. my @users;
  17.  
  18. # This is a simple connection.  Modify it to suit your needs.
  19. my  $dbh = DBI->connect(
  20.                         "dbi:Oracle:",
  21.                         "",
  22.                         "",
  23.                         {
  24.                          PrintError => 0,
  25.                          RaiseError => 1
  26.                         }
  27.     );
  28.  
  29. DDL::Oracle->configure( 
  30.                         dbh    => $dbh,
  31.                       );
  32.  
  33. # Printing prompts to STDERR allows the output to be
  34. # redirected to a file (a good idea, eh?) and still
  35. # allows the user to see the prompts.
  36.  
  37. print STDERR "\nEnter Name of Existing User (the Template) : ";
  38. chomp( $old_user = lc( <STDIN> ) );
  39. die "\nYou must specify an Existing User.\n" unless $old_user;
  40. print STDERR "\n";
  41.  
  42. $obj = DDL::Oracle->new(
  43.                          type  => 'user',
  44.                          list  => [
  45.                                     [
  46.                                       'n/a',
  47.                                       $old_user,
  48.                                     ]
  49.                                   ]
  50.                        );
  51.  
  52. $old_sql = $obj->create;   # Will FAIL unless $old_user exists!
  53.  
  54. while (1)
  55. {
  56.   print STDERR "Enter Name of New User or <ENTER> when done: ";
  57.   chomp( $new_user = lc( <STDIN> ) );
  58.   last unless $new_user;
  59.   push @users, $new_user;
  60. }
  61. die "\nYou must specify at least one New User\n\n" unless @users;
  62. print STDERR "\n";
  63.  
  64. foreach $new_user( @users )
  65. {
  66.   $new_sql = $old_sql;
  67.   $new_sql =~ s/$old_user/$new_user/go;
  68.   $new_sql =~ s/REM.*\n//go;
  69.  
  70.   {
  71.     # If $old_user is a Passworded Account 
  72.     # and if there is an arbitrary method of assigning
  73.     # passwords to new users, this is a good place to
  74.     # substitute the new password for the VALUES 'ABCDEF...'.
  75.  
  76.     # For example:
  77.     my $password = $new_user;
  78.     $new_sql =~ s/VALUES \S+/$password/go;
  79.   }
  80.  
  81.   $ddl .= $new_sql;
  82. }
  83.  
  84. print $ddl;
  85.  
  86. # $Log: copy_user.pl,v $
  87. # Revision 1.8  2001/04/28 13:49:32  rvsutherland
  88. # Changed password to be the new username.
  89. #
  90. # Revision 1.7  2001/03/03 18:41:31  rvsutherland
  91. # Added DESCRIPTION to pod.
  92. #
  93. # Revision 1.6  2001/01/27 16:21:44  rvsutherland
  94. # Added NAME section to pod.
  95. #
  96. # Revision 1.5  2001/01/14 16:47:55  rvsutherland
  97. # Nominal changes for version 0.32
  98. #
  99. # Revision 1.4  2001/01/07 16:43:56  rvsutherland
  100. # Added COPYRIGHT
  101. #
  102. # Revision 1.3  2000/11/11 07:48:59  rvsutherland
  103. # Added CVS tags
  104. #
  105. # Revision 1.2  2000/11/11 00:20:42  rvsutherland
  106. # Initial revision
  107. #
  108.  
  109. =head1 NAME
  110.  
  111. copy_user.pl - Generates CREATE USER command(s)
  112.  
  113. =head1 DESCRIPTION
  114.  
  115. Generates the DDL to create a new user(s) with the identical privileges
  116. of a named, existing user in the same database.
  117.  
  118. =head1 AUTHOR
  119.  
  120.  Richard V. Sutherland
  121.  rvsutherland@yahoo.com
  122.  
  123. =head1 COPYRIGHT
  124.  
  125. Copyright (c) 2000, 2001 Richard V. Sutherland.  All rights reserved.
  126. This module is free software.  It may be used, redistributed, and/or
  127. modified under the same terms as Perl itself.  See:
  128.  
  129.     http://www.perl.com/perl/misc/Artistic.html
  130.  
  131. =cut
  132.  
  133.