Commit a451aff0 authored by Peter Pentchev's avatar Peter Pentchev

[svn-inject] Installing original source of libdbix-password-perl

parents
Revision history for Perl extension DBIx::Password.
1.7 Wed Dec 20 13:45:29 PST 2000
-Returns undef if DBI connect fails (never has
occured to me, but I can certainly see it being
a problem).
1.6 Mon Nov 6 13:44:10 PST 2000
-Fixed each operator
-Removed MakePauseHappy.
1.5 Sun Oct 22 12:30:21 PDT 2000
-Added checkVirtualUser
-Added connect_cached
-More fixes to dummy file
1.4 Sep 13 19:09:04 PDT 2000
-Added dummy file for CPAN
1.3 Sep 8 11:58:29 2000
-Added support for PostgreSQL
-Added port for MySQL
-Added support for just adding in the connect string raw
1.2 Fri August 26 19:48:00 2000
- New version includes cache'ing of old methods
and getDriver() method that was needed for slashcode
1.1 Fri July 1 14:29:27 2000
- First version released to the outside world
0.01 Fri Jun 30 11:26:39 2000
- Created Makefile to make it easier for others to install
/* ====================================================================
* Copyright (c) 1999-2000 Brian Aker. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in
* the documentation and/or other materials provided with the
* distribution.
*
* 3. The name of the author may not be used to endorse or promote products
* derived from this software without specific prior written permission.
*
* 4. The name "DBIx::Password" must not be used to
* endorse or promote products derived from this software without
* prior written permission. For written permission, please contact
* brian@tangent.org.
*
* 5. Products derived from this software may not be called "DBIx::Password".
*
* THIS SOFTWARE IS PROVIDED BY BRIAN AKER ``AS IS'' AND ANY
* EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL BRIAN AKER OR
* ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
* OF THE POSSIBILITY OF SUCH DAMAGE.
* ====================================================================
*/
Changes
Makefile.PL
MANIFEST
test.pl-orig
Password.pm-orig
Password.pm
LICENSE
README
VERSION
use ExtUtils::MakeMaker;
use Data::Dumper;
use strict;
# Let's ask some questions
my $virtuals = {};
my $dumped;
if (-e '.cache') {
print "Oh, I can see that you have run me before, should I reuse these?(y or n)\n";
my $answer = getLine();
if($answer eq 'y') {
open(FILEHANDLE, "<.cache");
my @file = <FILEHANDLE>;
$dumped = join ('', @file);
goto JUMPOINT;
}
}
my %driver_methods = (
'mysql' => \&createMySQL,
'Pg' => \&createPostgreSQL,
);
print "What is the name of the Virtual User?\n";
my $virtual = getLine();
while ($virtual) {
print "What is the dbi driver? (AKA mysql)\n";
my $driver = getLine();
if($driver_methods{$driver}) {
$driver_methods{$driver}->($virtual, $driver);
} else {
print "Unsupported driver, send mail to brian\@tangent.org about supporting it. \n";
print "For now we will let you just enter the connect string by hand. \n";
createDefault($driver);
}
$virtual = undef;
print "What is the name of the Virtual User?\n";
print "(Enter nothing if you are finished adding users.)\n";
$virtual = getLine();
}
#Now, lets build up our data structure
my $data = Data::Dumper->new([$virtuals]);
$data->Purity(1);
$data->Indent(3);
$data->Varname('virtual');
$dumped = $data->Dump();
JUMPOINT:
makeFile();
makeTest();
makeCache();
#Now, lets grab the version
open (FILEHANDLE, "VERSION");
my $version = <FILEHANDLE>;
close (FILEHANDLE);
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'DBIx::Password',
'VERSION' => $version, # finds $VERSION
);
sub getLine {
my $data = <STDIN>;
chomp($data);
return $data;
}
sub makeFile {
open(FILEHANDLE, "Password.pm-orig");
my @file = <FILEHANDLE>;
close (FILEHANDLE);
open(FILEHANDLE, ">Password.pm");
for (@file) {
chomp($_);
if(/#PASSWORD_INSERT/) {
print FILEHANDLE ("my $dumped\n");
} else {
print FILEHANDLE ("$_\n");
}
}
close (FILEHANDLE);
}
sub makeTest {
open(FILEHANDLE, "test.pl-orig");
my @file = <FILEHANDLE>;
close (FILEHANDLE);
open(FILEHANDLE, ">test.pl");
for (@file) {
chomp($_);
if(/#PASSWORD_INSERT/) {
print FILEHANDLE ("my $dumped\n");
} else {
print FILEHANDLE ("$_\n");
}
}
close (FILEHANDLE);
}
sub makeCache {
open(FILEHANDLE, ">.cache");
print FILEHANDLE $dumped;
close (FILEHANDLE);
}
sub createMySQL {
my %attributes;
my $driver = 'mysql';
print "What is the name of the database?\n";
my $database = getLine();
print "What is the name of the machine that the database is on?\n";
my $hostname = getLine();
my $connect = "DBI:$driver:database=$database;host=$hostname";
print "Is the database on any special port(you should probably just hit return)?\n";
my $port = getLine();
$connect .= ";port=$port" if $port;
print "What is the username?\n";
my $username = getLine();
print "What is the password?\n";
my $password = getLine();
print "What attributes would you like to add?\n";
print "(Enter nothing to skip or finish)\n";
my $attr = getLine();
while($attr) {
print "What is the value of the attribute?\n";
my $value = getLine();
$attributes{$attr} = $value;
print "What attributes would you like to add?\n";
print "(Enter nothing to skip or finish)\n";
$attr = getLine();
}
$virtuals->{$virtual} = {
connect => $connect,
driver => $driver,
database => $database,
host => $hostname,
port => $port,
username => $username,
password => $password,
attributes => \%attributes
};
}
sub createPostgreSQL {
my $driver = 'Pg';
print "What is the name of the database?\n";
my $database = getLine();
print "What is the name of the machine that the database is on?\n";
my $hostname = getLine();
my $connect;
if ($hostname) {
$connect = "DBI:$driver:dbname=$database;host=$hostname";
} else {
$connect = "DBI:$driver:dbname=$database";
}
print "Is the database on any special port(you should probably just hit return)?\n";
my $port = getLine();
$connect .= ";port=$port" if $port;
print "What is the username?\n";
my $username = getLine();
print "What is the password?\n";
my $password = getLine();
$virtuals->{$virtual} = {
connect => $connect,
driver => $driver,
database => $database,
host => $hostname,
port => $port,
username => $username,
password => $password,
};
}
sub createDefault{
my ($driver) = @_;
print "What is the connect string?\n";
my $connect = getLine();
print "What is the username?\n";
my $username = getLine();
print "What is the password?\n";
my $password = getLine();
$virtuals->{$virtual} = {
connect => $connect,
driver => $driver,
username => $username,
password => $password,
};
}
package DBIx::Password;
use strict;
use DBI();
@DBIx::Password::ISA = qw ( DBI::db );
($DBIx::Password::VERSION) = ' $Revision: 1.8 $ ' =~ /\$Revision:\s+([^\s]+)/;
my $virtual1 = {
'slash' => {
'username' => '',
'password' => '',
'port' => '',
'database' => 'sdf',
'attributes' => {},
'connect' => 'DBI:mysql:database=sdf;host=asf',
'driver' => 'mysql',
'host' => 'asf'
}
};
my %driver_cache;
sub connect {
my ($class, $user, $options) = @_;
return undef unless $virtual1->{$user};
my $self;
my $virtual = $virtual1->{$user};
return unless $virtual;
$self = DBI->connect($virtual->{connect}
, $virtual->{'username'}
, $virtual->{'password'}
, $virtual->{'attributes'}
);
bless $self, $class;
$driver_cache{$self} = $user;
return $self;
}
sub connect_cached {
my ($class, $user, $options) = @_;
return undef unless $virtual1->{$user};
my $self;
my $virtual = $virtual1->{$user};
$self = DBI->connect_cached($virtual->{connect}
, $virtual->{'username'}
, $virtual->{'password'}
, $virtual->{'attributes'}
);
return unless $self;
bless $self, $class;
$driver_cache{$self} = $user;
return $self;
}
sub getDriver {
my ($self) = @_;
unless(ref $self) {
for my $key (keys %$virtual1) {
return $virtual1->{$key}->{'driver'} if $self eq $key;
}
} else {
my $user = $driver_cache{$self};
return $virtual1->{$user}{'driver'};
}
}
sub checkVirtualUser {
my ($user) = @_;
return 1
if $virtual1->{$user};
return 0;
}
sub DESTROY {
my ($self) = @_;
$self->SUPER::DESTROY;
}
1;
=head1 NAME
DBIx::Password - Allows you to create a global password file for DB passwords
=head1 SYNOPSIS
use DBIx::Password;
my $dbh = DBIx::Password->connect($user);
my $dbh = DBIx::Password->connect_cached($user);
$dbh->getDriver;
DBIx::Password::getDriver($user);
DBIx::Password::checkVirtualUser($user);
=head1 DESCRIPTION
Don't you hate keeping track of database passwords and such throughout
your scripts? How about the problem of changing those passwords
on a mass scale? This module is one possible solution. When you
go to build this module it will ask you to create virtual users.
For each user you need to specify the database module to use,
the database connect string, the username and the password. You
will be prompted to give a name to this virtual user.
You can add as many as you like.
I would recommend that if you are only using this with
web applications that you change the final permissions on this
package after it is installed in site_perl such that only
the webserver can read it.
A method called getDriver has been added so that you
can determine what driver is being used (handy for
working out database indepence issues).
If you want to find out if the virtual user is valid,
you can call the class method checkVirtualUser().
It returns true (1) if the username is valid, and
zero if not.
Once your are done you can use the connect method (or
the connect_cache method) that comes with DBIx-Password
and just specify one of the virtual users you defined
while making the module.
BTW I learned the bless hack that is used from Apache::DBI
so some credit should go to the authors of that module.
This is a rewrite of the module Tangent::DB that I did
for slashcode.
Hope you enjoy it.
=head1 INSTALL
Basically:
perl Makefile.PL
make
make test
make install
Be sure to answer the questions as you make the module
=head1 HOME
To find out more information look at: http://software.tangent.org/projects.pl?view=DBIxPassword
=head1 AUTHOR
Brian Aker, brian@tangent.org
=head1 SEE ALSO
perl(1). DBI(3).
=cut
package DBIx::Password;
use strict;
use DBI();
@DBIx::Password::ISA = qw ( DBI::db );
($DBIx::Password::VERSION) = ' $Revision: 1.8 $ ' =~ /\$Revision:\s+([^\s]+)/;
#PASSWORD_INSERT
my %driver_cache;
sub connect {
my ($class, $user, $options) = @_;
return undef unless $virtual1->{$user};
my $self;
my $virtual = $virtual1->{$user};
return unless $virtual;
$self = DBI->connect($virtual->{connect}
, $virtual->{'username'}
, $virtual->{'password'}
, $virtual->{'attributes'}
);
bless $self, $class;
$driver_cache{$self} = $user;
return $self;
}
sub connect_cached {
my ($class, $user, $options) = @_;
return undef unless $virtual1->{$user};
my $self;
my $virtual = $virtual1->{$user};
$self = DBI->connect_cached($virtual->{connect}
, $virtual->{'username'}
, $virtual->{'password'}
, $virtual->{'attributes'}
);
return unless $self;
bless $self, $class;
$driver_cache{$self} = $user;
return $self;
}
sub getDriver {
my ($self) = @_;
unless(ref $self) {
for my $key (keys %$virtual1) {
return $virtual1->{$key}->{'driver'} if $self eq $key;
}
} else {
my $user = $driver_cache{$self};
return $virtual1->{$user}{'driver'};
}
}
sub checkVirtualUser {
my ($user) = @_;
return 1
if $virtual1->{$user};
return 0;
}
sub DESTROY {
my ($self) = @_;
$self->SUPER::DESTROY;
}
1;
=head1 NAME
DBIx::Password - Allows you to create a global password file for DB passwords
=head1 SYNOPSIS
use DBIx::Password;
my $dbh = DBIx::Password->connect($user);
my $dbh = DBIx::Password->connect_cached($user);
$dbh->getDriver;
DBIx::Password::getDriver($user);
DBIx::Password::checkVirtualUser($user);
=head1 DESCRIPTION
Don't you hate keeping track of database passwords and such throughout
your scripts? How about the problem of changing those passwords
on a mass scale? This module is one possible solution. When you
go to build this module it will ask you to create virtual users.
For each user you need to specify the database module to use,
the database connect string, the username and the password. You
will be prompted to give a name to this virtual user.
You can add as many as you like.
I would recommend that if you are only using this with
web applications that you change the final permissions on this
package after it is installed in site_perl such that only
the webserver can read it.
A method called getDriver has been added so that you
can determine what driver is being used (handy for
working out database indepence issues).
If you want to find out if the virtual user is valid,
you can call the class method checkVirtualUser().
It returns true (1) if the username is valid, and
zero if not.
Once your are done you can use the connect method (or
the connect_cache method) that comes with DBIx-Password
and just specify one of the virtual users you defined
while making the module.
BTW I learned the bless hack that is used from Apache::DBI
so some credit should go to the authors of that module.
This is a rewrite of the module Tangent::DB that I did
for slashcode.
Hope you enjoy it.
=head1 INSTALL
Basically:
perl Makefile.PL
make
make test
make install
Be sure to answer the questions as you make the module
=head1 HOME
To find out more information look at: http://software.tangent.org/projects.pl?view=DBIxPassword
=head1 AUTHOR
Brian Aker, brian@tangent.org
=head1 SEE ALSO
perl(1). DBI(3).
=cut
NAME
DBIx::Password - Allows you to create a global password file for
DB passwords
SYNOPSIS
use DBIx::Password;
my $dbh = DBIx::Password->connect($user);
my $dbh = DBIx::Password->connect_cached($user);
$dbh->getDriver;
DBIx::Password::getDriver($user);
DBIx::Password::checkVirtualUser($user);
DESCRIPTION
Don't you hate keeping track of database passwords and such
throughout your scripts? How about the problem of changing those
passwords on a mass scale? This module is one possible solution.
When you go to build this module it will ask you to create
virtual users. For each user you need to specify the database
module to use, the database connect string, the username and the
password. You will be prompted to give a name to this virtual
user. You can add as many as you like.
I would recommend that if you are only using this with web
applications that you change the final permissions on this
package after it is installed in site_perl such that only the
webserver can read it.
A method called getDriver has been added so that you can
determine what driver is being used (handy for working out
database indepence issues).
If you want to find out if the virtual user is valid, you can
call the class method checkVirtualUser(). It returns true (1) if
the username is valid, and zero if not.
Once your are done you can use the connect method (or the
connect_cache method) that comes with DBIx-Password and just
specify one of the virtual users you defined while making the
module.
BTW I learned the bless hack that is used from Apache::DBI so
some credit should go to the authors of that module. This is a
rewrite of the module Tangent::DB that I did for slashcode.
Hope you enjoy it.
INSTALL
Basically:
perl Makefile.PL
make
make test
make install
Be sure to answer the questions as you make the module
HOME
To find out more information look at:
http://software.tangent.org/projects.pl?view=DBIxPassword
AUTHOR
Brian Aker, brian@tangent.org
SEE ALSO
perl(1). DBI(3).
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use DBIx::Password;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
#PASSWORD_INSERT
print "##################Note!#########################\n";
print "If you are not on the machine that will be using \n";
print "these passwords this will most likely fail. \n";
print "Now, lets test getDriver() by itself\n";
print "Finding driver:" . DBIx::Password::getDriver($_) . "\n"
for (keys %$virtual1);
print "Now, lets see if we can make create objects\n";
while (my ($key, $val) = each %$virtual1) {
print "Trying: $key\n";
my $object = DBIx::Password->connect($key);
print "Finding driver:" . $object->getDriver() . "\n";
$object->disconnect;
}
print "ok 2\n";
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment