+++ /dev/null
-#!/usr/bin/perl
-#
-# This Koha test module is a stub!
-# Add more tests here!!!
-
-use strict;
-use warnings;
-
-use Test::More tests => 3;
-
-BEGIN {
- use_ok('C4::Acquisition');
-}
-
-my ($basket, $basketno);
-ok($basketno = NewBasket(1,1), "NewBasket( 1 , 1 ) returns $basketno");
-ok($basket = GetBasket($basketno), "GetBasket($basketno) returns $basket");
-
+++ /dev/null
-#!/usr/bin/perl
-#
-# This Koha test module is a stub!
-# Add more tests here!!!
-
-use strict;
-use warnings;
-
-use Test::More tests => 6;
-
-BEGIN {
- use_ok('C4::Auth', qw(checkpw));
- use_ok('C4::Context');
-}
-
-use vars qw($dbh $ldap);
-can_ok('C4::Context', 'config');
-can_ok('C4::Context', 'dbh');
-can_ok('C4::Auth', qw(checkpw));
- ok($dbh = C4::Context->dbh(), "Getting dbh from C4::Context");
-$ldap = C4::Context->config('useldapserver') || 0;
-diag("Using LDAP? $ldap");
-
-while (1) { # forever!
- print "Do you want to test further accounts? (If not, just hit return.)\n";
- my ($user, $pass);
- print "Enter username: ";
- chomp($user = <>);
- ($user) or exit;
- print "Enter password: ";
- chomp($pass = <>);
- my ($retval,$retcard) = checkpw($dbh,$user,$pass);
- $retval ||= '';
- $retcard ||= '';
- diag ("checkpw(\$dbh,$user,$pass) " . ($retval ? 'SUCCEEDS' : ' FAILS ') . "\treturns ($retval,$retcard)");
-}
-
-END {
- diag("C4::Auth - end of test");
-}
-__END__
+++ /dev/null
-#!/bin/perl
-#
-
-use strict;
-use warnings;
-
-use Test::More;
-use vars qw(%cases $dbh $config $context $ldap);
-
-BEGIN {
- %cases = (
- # users from t/LDAP/example3.ldif
- sss => 'password1',
- jts => 'password1',
- rch => 'password2',
- jmf => 'password3',
- );
- plan tests => 7 + scalar(keys %cases);
- use_ok('C4::Context');
- use_ok('C4::Auth_with_ldap', qw(checkpw_ldap));
-}
-
-sub do_checkpw_ldap (;$$) {
- my ($user,$pass) = (shift,shift);
- diag "($user,$pass)";
- my $ret;
- return ($ret = checkpw_ldap($dbh,$user,$pass), sprintf("(%s,%s) returns '%s'",$user,$pass,$ret));
-}
-
-ok($context= C4::Context->new(), "Getting new C4::Context object");
-ok($dbh = C4::Context->dbh(), "Getting dbh from C4::Context");
-ok($dbh = $context->dbh(), "Getting dbh from \$context object");
-
-diag("The basis of Authentication is that we don't auth everybody.");
-diag("Let's make sure we reject on bad calls.");
-my $ret;
-ok(!($ret = checkpw_ldap($dbh)), "should reject ( no arguments) returns '$ret'");
-ok(!($ret = checkpw_ldap($dbh,'','')), "should reject (empty arguments) returns '$ret'");
-print "\n";
-diag("Now let's check " . scalar(keys %cases) . " test cases: ");
-foreach (sort keys %cases) {
- ok do_checkpw_ldap($_, $cases{$_});
-}
-
-1;
+++ /dev/null
-#!/usr/bin/perl
-#
-
-use strict;
-use warnings;
-
-use Test::More tests => 91;
-use vars qw($debug $koha $dbh $config $ret);
-
-BEGIN {
- $debug = $ENV{DEBUG} || 0;
- diag("Note: The overall number of tests may vary by configuration.");
- diag("First we need to check your environmental variables");
- for (qw(KOHA_CONF PERL5LIB)) {
- ok($ret = $ENV{$_}, "ENV{$_} = $ret");
- }
- use_ok('C4::Context');
- use_ok('C4::Utils', qw/ :all /);
-}
-
-ok($koha = C4::Context->new, 'C4::Context->new');
-ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context');
-ok($ret = C4::Context->KOHAVERSION, ' (function) KOHAVERSION = ' . ($ret||''));
-ok($ret = $koha->KOHAVERSION, ' $koha->KOHAVERSION = ' . ($ret||''));
-my @keys = keys %$koha;
-diag("Number of keys in \%\$koha: " . scalar @keys);
-our $width = 0;
-if (ok(@keys)) {
- $width = maxwidth(@keys);
- $debug and diag "widest key is $width";
-}
-foreach (sort @keys) {
- ok(exists $koha->{$_},
- '$koha->{' . sprintf('%' . $width . 's', $_) . '} exists '
- . ((defined $koha->{$_}) ? "and is defined." : "but is not defined.")
- );
-}
-diag "Examining defined key values.";
-foreach (grep {defined $koha->{$_}} sort @keys) {
- print "\n";
- hashdump('$koha->{' . sprintf('%' . $width . 's', $_) . '}', $koha->{$_});
-}
-ok($config = $koha->{config}, 'Getting $koha->{config} ');
-
-# diag("Examining configuration.");
-diag("Note: The overall number of tests may vary by configuration. Disregard the projected number.");
-1;
-__END__
-
+++ /dev/null
-dn: dc=metavore,dc=com
-dc: metavore
-description: Metavore as a company
-objectclass: dcObject
-objectclass: organization
-objectclass: top
-o: metavore
-
-# dn: cn=Manager,dc=metavore,dc=com
-# objectclass: top
-# objectclass: organizationalRole
-# description: Manager of LDAP
-# cn: Manager
-
-dn: ou=people,dc=metavore,dc=com
-objectClass: organizationalunit
-objectClass: top
-ou: people
-description: Persons in the organization
-
-dn: cn=jts,dc=metavore,dc=com
-objectClass: inetOrgPerson
-o: metavore
-postalAddress: 345 Fake Street
-l: Cleveland
-st: Ohio
-postalCode: 43366
-initials: jts
-cn: jts
-cn: John Smith
-cn: John T. Smith
-givenname: John
-sn: Smith
-userid: jts
-userPassword: password1
-sn;lang-en: Smith
-sn;lang-de: Schmidt
-ou: people
-mail: fake_user@liblime.com
-telephoneNumber: 1 555 123-4567
-
-dn: cn=sss,dc=metavore,dc=com
-objectClass: inetOrgPerson
-o: metavore
-postalAddress: Hugstetter Str. 55
-l: Freiburg
-st: Baden-Wurttemberg
-postalCode: 79106
-initials: sss
-cn: sss
-cn: Steve Smith
-cn: Steve S. Smith
-givenname: Steve
-sn: Smith
-userid: sss
-userPassword: password1
-sn;lang-en: Smith
-sn;lang-de: Schmidt
-ou: people
-mail: fake_user@liblime.com
-telephoneNumber: +49 761 270-2020
-
-dn: cn=rch,dc=metavore,dc=com
-objectClass: inetOrgPerson
-o: metavore
-postalAddress: 449 E. State St.
-l: Athens
-st: Ohio
-initials: rch
-cn: rch
-cn: Ryan Higgins
-givenname: Ryan
-sn: Higgins
-userPassword: password2
-userid: rch
-ou: people
-mail: rch@liblime.com
-telephoneNumber: 1 740 593-6589
-
-dn: cn=jmf,dc=metavore,dc=com
-objectClass: person
-objectClass: inetOrgPerson
-o: metavore
-postalAddress: 449 E. State St.
-l: Athens
-st: Ohio
-initials: jmf
-cn: jmf
-cn: Josh M. Ferraro
-givenname: Josh
-sn: Ferraro
-userid: jmf
-userPassword: password3
-ou: people
-mail: jmf@liblime.com
-telephoneNumber: 1 740 707 7654
-
-# dn: o=University of Alaska Fairbanks, c=US
-# o: University of Alaska Fairbanks
-# description: Preparing Alaska for a brave new yesterday
-# description: leaf node only
-#
-# dn: o=University of Colorado at Boulder, c=US
-# o: University of Colorado at Boulder
-# description: No personnel information
-# description: Institution of education and research
-#
-# dn: o=University of Colorado at Denver, c=US
-# o: University of Colorado at Denver
-# o: UCD
-# o: CU/Denver
-# o: CU-Denver
-# description: Institute for Higher Learning and Research
-#
-# dn: o=University of Florida, c=US
-# o: University of Florida
-# o: UFl
-# description: Warper of young minds
+++ /dev/null
-#!/usr/bin/perl
-#
-# To start out, try something like this against your LDAP:
-# ldapadd -w metavore -D'cn=Manager,dc=metavore,dc=com' -c -f example3.ldif
-# ldapmodify -w metavore -D'cn=Manager,dc=metavore,dc=com' -c -f example3.ldif
-#
-# Then run this script to test perl interaction w/ LDAP.
-#
-
-use warnings;
-use strict;
-
-use Net::LDAP;
-use Net::LDAP::Filter;
-
-my $host = (@ARGV) ? shift : 'localhost';
-my $filter = Net::LDAP::Filter->new((@ARGV) ? shift : 'objectClass=inetOrgPerson');
-my %params = (
- base => (@ARGV) ? shift : 'dc=metavore,dc=com',
- filter => $filter,
-);
-
-my $ldap = Net::LDAP->new($host) or die "Cannot connect to ldap on $host";
-$ldap->bind("cn=Manager," . $params{'base'}, password=>'metavore') or die "Cannot bind to ldap on $host";
-&ldap_dse;
-&ldap_search;
-&ldap_add;
-&ldap_search;
-
-sub hashup {
- my $query = shift or die "Bad hashup call";
- my %memberhash = ();
- my $key;
- foreach my $user ($query->shift_entry){
- foreach my $k (@$user) {
- foreach my $k2 ( keys %$k ) {
- if ($k2 eq 'type') {
- $key = $$k{$k2};
- } else {
- $memberhash{$key} .= map {$_ . " "} @$k{$k2};
- }
- }
- }
- }
- return %memberhash;
-}
-
-sub recursive_breakdown {
- my $dse = shift or return undef;
- if (ref($dse) =~ /HASH/) {
- return join "\n", map {"$_\t=> " . recursive_breakdown($dse->{$_})} keys %$dse;
- } elsif (ref($dse) =~ /ARRAY/) {
- return " (\n" . join("\n", map {recursive_breakdown($_)} @$dse) . "\n)\n";
- } else {
- return $dse;
- }
-}
-
-sub ldap_dse {
- print "my root DSE: \n";
- print recursive_breakdown $ldap->root_dse();
-}
-
-sub ldap_search {
- my $query = $ldap->search(%params) or print "Search failed\n";
- $query->code and die sprintf 'error (code:%s) - %s', $query->code , $query->error;
- my $size = scalar($query->entries);
- my $i=5;
- print "\nNumber of records returned from search: $size.\n";
- ($size > $i) and print "Displaying the last $i records.\n\n";
- foreach ($query->entries) {
- ($size-- > $i) and next;
- $_->dump;
- }
-}
-
-sub ldap_add {
- my $cn = shift or return 0;
- my $mail = lc $cn;
- $mail =~ s/\s+/./;
- print "Adding user $cn\n";
- my $add;
- $add = $ldap->add(
- "cn=$cn," . $params{'base'},
- attr => [
- cn => $cn,
- sn => 'atz',
- mail => $mail . '@liblime.com',
- telephoneNumber => '1 614 266 9798',
- description => 'Implementer and Destroyer',
- objectclass => ['person','inetOrgPerson'],
- ])
- or printf "Add failed (code %s): %s\n", ($add->code||'unknown'), ($add->error||'unknown');
-}
-
-END {
- ($ldap) and $ldap->unbind;
- print "\ndone.\n";
-}
+++ /dev/null
-#!/usr/bin/perl
-
-#
-# This file is a test script for C4::VirtualShelves.pm
-# Author : Antoine Farnault, antoine@koha-fr.org
-#
-
-use Test;
-use strict;
-use C4::Context;
-
-# Making 30 tests.
-BEGIN { plan tests => 30 }
-
-# Getting some borrowers from database.
-my $dbh = C4::Context->dbh;
-my $query = qq/
- SELECT borrowernumber
- FROM borrowers
- LIMIT 10
-/;
-my $sth = $dbh->prepare($query);
-$sth->execute;
-my @borrowers;
-while(my $borrower = $sth->fetchrow){
- push @borrowers, $borrower;
-}
-
-# Getting some itemnumber from database
-my $query = qq/
- SELECT itemnumber
- FROM items
- LIMIT 10
-/;
-my $sth = $dbh->prepare($query);
-$sth->execute;
-my @items;
-while(my $item = $sth->fetchrow){
- push @items, $item;
-}
-
-# Getting some biblionumbers from database
-my $query = qq/
- SELECT biblionumber
- FROM biblio
- LIMIT 10
-/;
-my $sth = $dbh->prepare($query);
-$sth->execute;
-my @biblionumbers;
-while(my $biblionumber = $sth->fetchrow){
- push @biblionumbers, $biblionumber;
-}
-
-# ---
-my $delete_virtualshelf = qq/
- DELETE FROM virtualshelf WHERE 1
-/;
-my $delete_virtualshelfcontent =qq/
- DELETE FROM shelfcontents WHERE 1
-/;
-
-my $sth = $dbh->prepare($delete_virtualshelf);
-$sth->execute;
-my $sth = $dbh->prepare($delete_virtualshelfcontent);
-$sth->execute;
-# ---
-
-#----------------------------------------------------------------------#
-#
-# TESTS START HERE
-#
-#----------------------------------------------------------------------#
-
-use C4::VirtualShelves;
-my $version = C4::VirtualShelves->VERSION;
-print "\n----------Testing C4::VirtualShelves version ".$version."--------\n";
-
-ok($version); # First test: the module is loaded & the version is readable.
-
-
-#-----------------------TEST AddShelf function------------------------#
-# usage : $shelfnumber = &AddShelf( $shelfname, $owner, $category);
-
-# creating 10 good shelves.
-my @shelves;
-for(my $i=0; $i<10;$i++){
- my $ShelfNumber = AddShelf("Shelf_".$i,$borrowers[$i],int(rand(3))+1);
- die "test Not ok, remove some shelves before" if ($ShelfNumber == -1);
- ok($ShelfNumber); # Shelf creation successful;
- push @shelves, $ShelfNumber if ok($ShelfNumber);
-}
-
-ok(10,scalar @shelves); # 10 shelves in @shelves;
-
-# try to create some shelf which already exists.
-for(my $i=0;$i<10;$i++){
- my $badNumShelf = AddShelf("Shelf_".int(rand(9)),'','');
- ok(-1,$badNumShelf); # AddShelf returns -1 if name already exist.
-}
-
-#-----------TEST AddToShelf & &AddToShelfFromBiblio & GetShelfContents & DelFromShelf functions--------------#
-# usage : &AddToShelf($itemnumber, $shelfnumber);
-# usage : $itemlist = &GetShelfContents($shelfnumber);
-# usage : $itemlist = GetShelfContents($shelfnumber);
-
-for(my $i=0; $i<10;$i++){
- my $item = $items[int(rand(9))];
- my $shelfnumber = $shelves[int(rand(9))];
-
- my $itemlistBefore = GetShelfContents($shelfnumber);
- AddToShelf($item,$shelfnumber);
- my $itemlistAfter = GetShelfContents($shelfnumber);
- ok(scalar @$itemlistBefore,scalar (@$itemlistAfter - 1)); # the item has been successfuly added.
-
-
- # same thing with AddToShelfFromBiblio
- my $biblionumber = $biblionumbers[int(rand(10))];
- &AddToShelfFromBiblio($biblionumber, $shelfnumber);
- my $AfterAgain = GetShelfContents($shelfnumber);
- ok(scalar @$itemlistAfter, scalar (@$AfterAgain -1));
-}
-
-#-----------------------TEST ModShelf & GetShelf functions------------------------#
-# usage : ModShelf($shelfnumber, $shelfname, $owner, $category )
-# usage : (shelfnumber,shelfname,owner,category) = GetShelf($shelfnumber);
-
-for(my $i=0; $i<10;$i++){
- my $rand = int(rand(9));
- my $numA = $shelves[$rand];
- my $nameA = "NewName_".$rand;
- my $ownerA = $borrowers[$rand];
- my $categoryA = int(rand(3))+1;
-
- ModShelf($numA,$nameA,$ownerA,$categoryA);
- my ($numB,$nameB,$ownerB,$categoryB) = GetShelf($numA);
-
- ok($numA,$numB);
- ok($nameA,$nameB);
- ok($ownerB,$ownerA);
- ok($categoryA,$categoryB);
-}
-
-#-----------------------TEST DelShelf & DelFromShelf functions------------------------#
-# usage : ($status) = &DelShelf($shelfnumber);
-# usage : &DelFromShelf( $itemnumber, $shelfnumber);
-
-for(my $i=0; $i<10;$i++){
- my $shelfnumber = $shelves[$i];
- my $status = DelShelf($shelfnumber);
- if($status){
- my $items = GetShelfContents($shelfnumber);
- ok($status,scalar @$items);
- foreach (@$items){ # delete all the item in this shelf
- DelFromShelf($_{'itemnumber'},$shelfnumber);
- }
- ok(DelShelf($shelfnumber));
- }
-}
--- /dev/null
+#!/usr/bin/perl
+#
+# This Koha test module is a stub!
+# Add more tests here!!!
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+BEGIN {
+ use_ok('C4::Acquisition');
+}
+
+my ($basket, $basketno);
+ok($basketno = NewBasket(1,1), "NewBasket( 1 , 1 ) returns $basketno");
+ok($basket = GetBasket($basketno), "GetBasket($basketno) returns $basket");
+
--- /dev/null
+#!/usr/bin/perl
+#
+# This Koha test module is a stub!
+# Add more tests here!!!
+
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+
+BEGIN {
+ use FindBin;
+ use lib $FindBin::Bin;
+ use override_context_prefs;
+ use_ok('C4::Auth', qw(checkpw));
+ use_ok('C4::Context');
+}
+
+use vars qw($dbh $ldap);
+can_ok('C4::Context', 'config');
+can_ok('C4::Context', 'dbh');
+can_ok('C4::Auth', qw(checkpw));
+ ok($dbh = C4::Context->dbh(), "Getting dbh from C4::Context");
+$ldap = C4::Context->config('useldapserver') || 0;
+diag("Using LDAP? $ldap");
+
+while (1) { # forever!
+ print "Do you want to test further accounts? (If not, just hit return.)\n";
+ my ($user, $pass);
+ print "Enter username: ";
+ chomp($user = <>);
+ ($user) or exit;
+ print "Enter password: ";
+ chomp($pass = <>);
+ my ($retval,$retcard) = checkpw($dbh,$user,$pass);
+ $retval ||= '';
+ $retcard ||= '';
+ diag ("checkpw(\$dbh,$user,$pass) " . ($retval ? 'SUCCEEDS' : ' FAILS ') . "\treturns ($retval,$retcard)");
+}
+
+END {
+ diag("C4::Auth - end of test");
+}
+__END__
--- /dev/null
+#!/bin/perl
+#
+
+use strict;
+use warnings;
+
+use Test::More;
+use vars qw(%cases $dbh $config $context $ldap);
+
+BEGIN {
+ %cases = (
+ # users from t/LDAP/example3.ldif
+ sss => 'password1',
+ jts => 'password1',
+ rch => 'password2',
+ jmf => 'password3',
+ );
+ plan tests => 7 + scalar(keys %cases);
+ use_ok('C4::Context');
+ use_ok('C4::Auth_with_ldap', qw(checkpw_ldap));
+}
+
+sub do_checkpw_ldap (;$$) {
+ my ($user,$pass) = (shift,shift);
+ diag "($user,$pass)";
+ my $ret;
+ return ($ret = checkpw_ldap($dbh,$user,$pass), sprintf("(%s,%s) returns '%s'",$user,$pass,$ret));
+}
+
+ok($context= C4::Context->new(), "Getting new C4::Context object");
+ok($dbh = C4::Context->dbh(), "Getting dbh from C4::Context");
+ok($dbh = $context->dbh(), "Getting dbh from \$context object");
+
+diag("The basis of Authentication is that we don't auth everybody.");
+diag("Let's make sure we reject on bad calls.");
+my $ret;
+ok(!($ret = checkpw_ldap($dbh)), "should reject ( no arguments) returns '$ret'");
+ok(!($ret = checkpw_ldap($dbh,'','')), "should reject (empty arguments) returns '$ret'");
+print "\n";
+diag("Now let's check " . scalar(keys %cases) . " test cases: ");
+foreach (sort keys %cases) {
+ ok do_checkpw_ldap($_, $cases{$_});
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl
+#
+
+use strict;
+use warnings;
+
+use Test::More tests => 91;
+use vars qw($debug $koha $dbh $config $ret);
+
+BEGIN {
+ $debug = $ENV{DEBUG} || 0;
+ diag("Note: The overall number of tests may vary by configuration.");
+ diag("First we need to check your environmental variables");
+ for (qw(KOHA_CONF PERL5LIB)) {
+ ok($ret = $ENV{$_}, "ENV{$_} = $ret");
+ }
+ use_ok('C4::Context');
+ use_ok('C4::Utils', qw/ :all /);
+}
+
+ok($koha = C4::Context->new, 'C4::Context->new');
+ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context');
+ok($ret = C4::Context->KOHAVERSION, ' (function) KOHAVERSION = ' . ($ret||''));
+ok($ret = $koha->KOHAVERSION, ' $koha->KOHAVERSION = ' . ($ret||''));
+my @keys = keys %$koha;
+diag("Number of keys in \%\$koha: " . scalar @keys);
+our $width = 0;
+if (ok(@keys)) {
+ $width = maxwidth(@keys);
+ $debug and diag "widest key is $width";
+}
+foreach (sort @keys) {
+ ok(exists $koha->{$_},
+ '$koha->{' . sprintf('%' . $width . 's', $_) . '} exists '
+ . ((defined $koha->{$_}) ? "and is defined." : "but is not defined.")
+ );
+}
+diag "Examining defined key values.";
+foreach (grep {defined $koha->{$_}} sort @keys) {
+ print "\n";
+ hashdump('$koha->{' . sprintf('%' . $width . 's', $_) . '}', $koha->{$_});
+}
+ok($config = $koha->{config}, 'Getting $koha->{config} ');
+
+# diag("Examining configuration.");
+diag("Note: The overall number of tests may vary by configuration. Disregard the projected number.");
+1;
+__END__
+
--- /dev/null
+dn: dc=metavore,dc=com
+dc: metavore
+description: Metavore as a company
+objectclass: dcObject
+objectclass: organization
+objectclass: top
+o: metavore
+
+# dn: cn=Manager,dc=metavore,dc=com
+# objectclass: top
+# objectclass: organizationalRole
+# description: Manager of LDAP
+# cn: Manager
+
+dn: ou=people,dc=metavore,dc=com
+objectClass: organizationalunit
+objectClass: top
+ou: people
+description: Persons in the organization
+
+dn: cn=jts,dc=metavore,dc=com
+objectClass: inetOrgPerson
+o: metavore
+postalAddress: 345 Fake Street
+l: Cleveland
+st: Ohio
+postalCode: 43366
+initials: jts
+cn: jts
+cn: John Smith
+cn: John T. Smith
+givenname: John
+sn: Smith
+userid: jts
+userPassword: password1
+sn;lang-en: Smith
+sn;lang-de: Schmidt
+ou: people
+mail: fake_user@liblime.com
+telephoneNumber: 1 555 123-4567
+
+dn: cn=sss,dc=metavore,dc=com
+objectClass: inetOrgPerson
+o: metavore
+postalAddress: Hugstetter Str. 55
+l: Freiburg
+st: Baden-Wurttemberg
+postalCode: 79106
+initials: sss
+cn: sss
+cn: Steve Smith
+cn: Steve S. Smith
+givenname: Steve
+sn: Smith
+userid: sss
+userPassword: password1
+sn;lang-en: Smith
+sn;lang-de: Schmidt
+ou: people
+mail: fake_user@liblime.com
+telephoneNumber: +49 761 270-2020
+
+dn: cn=rch,dc=metavore,dc=com
+objectClass: inetOrgPerson
+o: metavore
+postalAddress: 449 E. State St.
+l: Athens
+st: Ohio
+initials: rch
+cn: rch
+cn: Ryan Higgins
+givenname: Ryan
+sn: Higgins
+userPassword: password2
+userid: rch
+ou: people
+mail: rch@liblime.com
+telephoneNumber: 1 740 593-6589
+
+dn: cn=jmf,dc=metavore,dc=com
+objectClass: person
+objectClass: inetOrgPerson
+o: metavore
+postalAddress: 449 E. State St.
+l: Athens
+st: Ohio
+initials: jmf
+cn: jmf
+cn: Josh M. Ferraro
+givenname: Josh
+sn: Ferraro
+userid: jmf
+userPassword: password3
+ou: people
+mail: jmf@liblime.com
+telephoneNumber: 1 740 707 7654
+
+# dn: o=University of Alaska Fairbanks, c=US
+# o: University of Alaska Fairbanks
+# description: Preparing Alaska for a brave new yesterday
+# description: leaf node only
+#
+# dn: o=University of Colorado at Boulder, c=US
+# o: University of Colorado at Boulder
+# description: No personnel information
+# description: Institution of education and research
+#
+# dn: o=University of Colorado at Denver, c=US
+# o: University of Colorado at Denver
+# o: UCD
+# o: CU/Denver
+# o: CU-Denver
+# description: Institute for Higher Learning and Research
+#
+# dn: o=University of Florida, c=US
+# o: University of Florida
+# o: UFl
+# description: Warper of young minds
--- /dev/null
+#!/usr/bin/perl
+#
+# To start out, try something like this against your LDAP:
+# ldapadd -w metavore -D'cn=Manager,dc=metavore,dc=com' -c -f example3.ldif
+# ldapmodify -w metavore -D'cn=Manager,dc=metavore,dc=com' -c -f example3.ldif
+#
+# Then run this script to test perl interaction w/ LDAP.
+#
+
+use warnings;
+use strict;
+
+use Net::LDAP;
+use Net::LDAP::Filter;
+
+my $host = (@ARGV) ? shift : 'localhost';
+my $filter = Net::LDAP::Filter->new((@ARGV) ? shift : 'objectClass=inetOrgPerson');
+my %params = (
+ base => (@ARGV) ? shift : 'dc=metavore,dc=com',
+ filter => $filter,
+);
+
+my $ldap = Net::LDAP->new($host) or die "Cannot connect to ldap on $host";
+$ldap->bind("cn=Manager," . $params{'base'}, password=>'metavore') or die "Cannot bind to ldap on $host";
+&ldap_dse;
+&ldap_search;
+&ldap_add;
+&ldap_search;
+
+sub hashup {
+ my $query = shift or die "Bad hashup call";
+ my %memberhash = ();
+ my $key;
+ foreach my $user ($query->shift_entry){
+ foreach my $k (@$user) {
+ foreach my $k2 ( keys %$k ) {
+ if ($k2 eq 'type') {
+ $key = $$k{$k2};
+ } else {
+ $memberhash{$key} .= map {$_ . " "} @$k{$k2};
+ }
+ }
+ }
+ }
+ return %memberhash;
+}
+
+sub recursive_breakdown {
+ my $dse = shift or return undef;
+ if (ref($dse) =~ /HASH/) {
+ return join "\n", map {"$_\t=> " . recursive_breakdown($dse->{$_})} keys %$dse;
+ } elsif (ref($dse) =~ /ARRAY/) {
+ return " (\n" . join("\n", map {recursive_breakdown($_)} @$dse) . "\n)\n";
+ } else {
+ return $dse;
+ }
+}
+
+sub ldap_dse {
+ print "my root DSE: \n";
+ print recursive_breakdown $ldap->root_dse();
+}
+
+sub ldap_search {
+ my $query = $ldap->search(%params) or print "Search failed\n";
+ $query->code and die sprintf 'error (code:%s) - %s', $query->code , $query->error;
+ my $size = scalar($query->entries);
+ my $i=5;
+ print "\nNumber of records returned from search: $size.\n";
+ ($size > $i) and print "Displaying the last $i records.\n\n";
+ foreach ($query->entries) {
+ ($size-- > $i) and next;
+ $_->dump;
+ }
+}
+
+sub ldap_add {
+ my $cn = shift or return 0;
+ my $mail = lc $cn;
+ $mail =~ s/\s+/./;
+ print "Adding user $cn\n";
+ my $add;
+ $add = $ldap->add(
+ "cn=$cn," . $params{'base'},
+ attr => [
+ cn => $cn,
+ sn => 'atz',
+ mail => $mail . '@liblime.com',
+ telephoneNumber => '1 614 266 9798',
+ description => 'Implementer and Destroyer',
+ objectclass => ['person','inetOrgPerson'],
+ ])
+ or printf "Add failed (code %s): %s\n", ($add->code||'unknown'), ($add->error||'unknown');
+}
+
+END {
+ ($ldap) and $ldap->unbind;
+ print "\ndone.\n";
+}
--- /dev/null
+#!/usr/bin/perl
+
+#
+# This file is a test script for C4::VirtualShelves.pm
+# Author : Antoine Farnault, antoine@koha-fr.org
+#
+
+use Test;
+use strict;
+use C4::Context;
+
+# Making 30 tests.
+BEGIN { plan tests => 30 }
+
+# Getting some borrowers from database.
+my $dbh = C4::Context->dbh;
+my $query = qq/
+ SELECT borrowernumber
+ FROM borrowers
+ LIMIT 10
+/;
+my $sth = $dbh->prepare($query);
+$sth->execute;
+my @borrowers;
+while(my $borrower = $sth->fetchrow){
+ push @borrowers, $borrower;
+}
+
+# Getting some itemnumber from database
+my $query = qq/
+ SELECT itemnumber
+ FROM items
+ LIMIT 10
+/;
+my $sth = $dbh->prepare($query);
+$sth->execute;
+my @items;
+while(my $item = $sth->fetchrow){
+ push @items, $item;
+}
+
+# Getting some biblionumbers from database
+my $query = qq/
+ SELECT biblionumber
+ FROM biblio
+ LIMIT 10
+/;
+my $sth = $dbh->prepare($query);
+$sth->execute;
+my @biblionumbers;
+while(my $biblionumber = $sth->fetchrow){
+ push @biblionumbers, $biblionumber;
+}
+
+# ---
+my $delete_virtualshelf = qq/
+ DELETE FROM virtualshelf WHERE 1
+/;
+my $delete_virtualshelfcontent =qq/
+ DELETE FROM shelfcontents WHERE 1
+/;
+
+my $sth = $dbh->prepare($delete_virtualshelf);
+$sth->execute;
+my $sth = $dbh->prepare($delete_virtualshelfcontent);
+$sth->execute;
+# ---
+
+#----------------------------------------------------------------------#
+#
+# TESTS START HERE
+#
+#----------------------------------------------------------------------#
+
+use C4::VirtualShelves;
+my $version = C4::VirtualShelves->VERSION;
+print "\n----------Testing C4::VirtualShelves version ".$version."--------\n";
+
+ok($version); # First test: the module is loaded & the version is readable.
+
+
+#-----------------------TEST AddShelf function------------------------#
+# usage : $shelfnumber = &AddShelf( $shelfname, $owner, $category);
+
+# creating 10 good shelves.
+my @shelves;
+for(my $i=0; $i<10;$i++){
+ my $ShelfNumber = AddShelf("Shelf_".$i,$borrowers[$i],int(rand(3))+1);
+ die "test Not ok, remove some shelves before" if ($ShelfNumber == -1);
+ ok($ShelfNumber); # Shelf creation successful;
+ push @shelves, $ShelfNumber if ok($ShelfNumber);
+}
+
+ok(10,scalar @shelves); # 10 shelves in @shelves;
+
+# try to create some shelf which already exists.
+for(my $i=0;$i<10;$i++){
+ my $badNumShelf = AddShelf("Shelf_".int(rand(9)),'','');
+ ok(-1,$badNumShelf); # AddShelf returns -1 if name already exist.
+}
+
+#-----------TEST AddToShelf & &AddToShelfFromBiblio & GetShelfContents & DelFromShelf functions--------------#
+# usage : &AddToShelf($itemnumber, $shelfnumber);
+# usage : $itemlist = &GetShelfContents($shelfnumber);
+# usage : $itemlist = GetShelfContents($shelfnumber);
+
+for(my $i=0; $i<10;$i++){
+ my $item = $items[int(rand(9))];
+ my $shelfnumber = $shelves[int(rand(9))];
+
+ my $itemlistBefore = GetShelfContents($shelfnumber);
+ AddToShelf($item,$shelfnumber);
+ my $itemlistAfter = GetShelfContents($shelfnumber);
+ ok(scalar @$itemlistBefore,scalar (@$itemlistAfter - 1)); # the item has been successfuly added.
+
+
+ # same thing with AddToShelfFromBiblio
+ my $biblionumber = $biblionumbers[int(rand(10))];
+ &AddToShelfFromBiblio($biblionumber, $shelfnumber);
+ my $AfterAgain = GetShelfContents($shelfnumber);
+ ok(scalar @$itemlistAfter, scalar (@$AfterAgain -1));
+}
+
+#-----------------------TEST ModShelf & GetShelf functions------------------------#
+# usage : ModShelf($shelfnumber, $shelfname, $owner, $category )
+# usage : (shelfnumber,shelfname,owner,category) = GetShelf($shelfnumber);
+
+for(my $i=0; $i<10;$i++){
+ my $rand = int(rand(9));
+ my $numA = $shelves[$rand];
+ my $nameA = "NewName_".$rand;
+ my $ownerA = $borrowers[$rand];
+ my $categoryA = int(rand(3))+1;
+
+ ModShelf($numA,$nameA,$ownerA,$categoryA);
+ my ($numB,$nameB,$ownerB,$categoryB) = GetShelf($numA);
+
+ ok($numA,$numB);
+ ok($nameA,$nameB);
+ ok($ownerB,$ownerA);
+ ok($categoryA,$categoryB);
+}
+
+#-----------------------TEST DelShelf & DelFromShelf functions------------------------#
+# usage : ($status) = &DelShelf($shelfnumber);
+# usage : &DelFromShelf( $itemnumber, $shelfnumber);
+
+for(my $i=0; $i<10;$i++){
+ my $shelfnumber = $shelves[$i];
+ my $status = DelShelf($shelfnumber);
+ if($status){
+ my $items = GetShelfContents($shelfnumber);
+ ok($status,scalar @$items);
+ foreach (@$items){ # delete all the item in this shelf
+ DelFromShelf($_{'itemnumber'},$shelfnumber);
+ }
+ ok(DelShelf($shelfnumber));
+ }
+}
projects / koha.git / commitdiff