—#!/usr/bin/perl -w
use
strict;
my
$VERSION
=
'1.00'
;
#----------------------------------------------------------
# Loader Variables
my
$BASE
;
BEGIN {
$BASE
=
'../../cgi-bin'
;
}
#----------------------------------------------------------
# Library Modules
use
utf8;
use
Crypt::Lite;
use
Getopt::Long;
use
IO::File;
use
Labyrinth::Globals;
use
Labyrinth::Users;
use
Labyrinth::Variables;
#----------------------------------------------------------
# Variables
my
$config
=
"$BASE/config/settings.ini"
;
my
$crypt
= Crypt::Lite->new(
debug
=> 0,
encoding
=>
'hex8'
);
my
%options
;
#----------------------------------------------------------
# Code
if
(! GetOptions( \
%options
,
'update'
,
'nocode'
)) {
"usage: $0 [--update] [--nocode] <file>\n"
;
exit
;
}
die
"Usage: $0 [--update] [--nocode] <file>\n"
unless
(
@ARGV
);
my
$file
=
$ARGV
[0];
Labyrinth::Globals::LoadSettings(
$config
);
Labyrinth::Globals::DBConnect();
my
$key
=
$settings
{yapc_name};
my
$fh
= IO::File->new(
$file
,
'r'
) or
die
"Error: Cannot open file [$file]: $!\n"
;
while
(<
$fh
>) {
next
if
(/^\s*$/);
$_
=~ s/\s+$//;
my
(
$name
,
,
$actuserid
) =
split
(
','
,
$_
);
my
$userid
;
my
@rows
=
$dbi
->GetQuery(
'hash'
,
'FindUser'
,
);
if
(
@rows
) {
my
@keys
=
$dbi
->GetQuery(
'hash'
,
'GetUserCode'
,
$rows
[0]->{userid});
"FOUND: $email => $keys[0]->{code}/$rows[0]->{userid}\n"
;
next
unless
(
$options
{update});
$userid
=
$rows
[0]->{userid};
}
@rows
=
$dbi
->GetQuery(
'hash'
,
'FindUserByAct'
,
$actuserid
);
if
(
@rows
) {
my
@keys
=
$dbi
->GetQuery(
'hash'
,
'GetUserCode'
,
$rows
[0]->{userid});
"FOUND: $email => $keys[0]->{code}/$rows[0]->{userid}\n"
;
next
unless
(
$options
{update});
$userid
=
$rows
[0]->{userid};
}
my
$str
= $$ .
.
time
();
my
$code
= sha1_hex(
$crypt
->encrypt(
$str
,
$key
));
if
(
$userid
) {
if
(
$options
{nocode}) {
@rows
=
$dbi
->GetQuery(
'hash'
,
'GetUserCode'
,
$userid
);
$code
=
$rows
[0]->{code}
if
(
@rows
);
}
$dbi
->DoQuery(
'SaveUser'
,
''
,
$name
,
,
$userid
);
$dbi
->DoQuery(
'UpdateActUser'
,
$actuserid
,
$userid
)
if
(
$actuserid
);
}
else
{
#$name = encode_entities($name);
my
$pass
= Labyrinth::Users::FreshPassword();
$userid
=
$dbi
->IDQuery(
'NewUser'
,
$pass
,
''
,
$name
,
,0);
}
$dbi
->DoQuery(
'ConfirmUser'
,1,
$userid
);
$dbi
->DoQuery(
'SaveUserCode'
,
$code
,
$userid
)
unless
(
$options
{nocode});
"SAVED: $email => $code/$userid\n"
;
}
__END__
=head1 NAME
addusers.pl - script to add users to the survey system.
=head1 DESCRIPTION
This script adds users to the system, based on a CSV style file. File format
is:
#User Name, Email Address, ActUserID (if known)
Test User,test@example.com,
The ActUserID is the id of the user within the Act system, if known. The
ActUserID isn't needed generally, but it can help to verify whether a user has
already been added to the system with a different spelling of their name, or
different email address.
=head1 USAGE
addusers.pl [--update] [--nocode] <file>
=head1 OPTIONS
=over
=item --update
If a user is found by their email address, or actuserid if known, update the
user details with the data provided for that user.
=item --nocode
If the user has been found, this option will prevent a new keycode being
generated.
=back
=head1 SEE ALSO
L<Labyrinth>
=head1 BUGS, PATCHES & FIXES
There are no known bugs at the time of this release. However, if you spot a
bug or are experiencing difficulties that are not explained within the POD
documentation, please submit a bug report and/or patch via RT [1], or raise
an issue or submit a pull request via GitHub [2]. Note that it helps
immensely if you are able to pinpoint problems with examples, or supply a
patch.
Fixes are dependent upon their severity and my availability. Should a fix not
be forthcoming, please feel free to (politely) remind me.
=head1 AUTHOR
Barbie, <barbie@cpan.org>
Miss Barbell Productions, L<http://www.missbarbell.co.uk/>
=head1 COPYRIGHT
Copyright (C) 2006-2014 Barbie for Miss Barbell Productions
All Rights Reserved.
This distribution is free software; you can redistribute it and/or
modify it under the Artistic License 2.0.
=cut