File Coverage

blib/lib/OzDB.pm

Criterion	Covered	Total	%
statement	12	93	12.9
branch	0	40	0.0
condition	0	6	0.0
subroutine	4	9	44.4
pod	2	5	40.0
total	18	153	11.7

package OzDB;

use 5.008006;
use strict;
use warnings;
use Benchmark;

# Start the benchmark timer
 my $t0 = new Benchmark;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use OzDB ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

          ) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.02';
# 5/20/2005, NeXeN:  Yet another versioning scheme.  Altho PAUSE/CPAN
# allows for x.y.z versioning schema, we'll move to x.yz so it'll show
# the minor version number correctly, with the revision point as the
# last digit.
#
#

# 5/19/2005, NeXeN: The new versioning scheme has been reset back to
# 0.0.1 for distribution with cpan.  Please see the
# Changes file for more information.
#
# our $VERSION = '0.1.3';
#


# methods.
sub new {
# my $t0 = new Benchmark;
    my $package = shift;
    return bless( {}, $package );
# my $t1 = new Benchmark;
# my $td = timediff($t1, $t0);
# print "Your OzDB Request took aproximately ", timestr($td),"\n\nThe results of your request are as follows:\n\n\n";

}

sub verbose {
    my $self = shift;
    if (@_) {
        $self->{'verbose'} = shift;
    }
    return $self->{'verbose'};
}

sub add_user {

# add_user method allows for 4 arguments exactly like authenticate.  The only
# difference is the second argument is ignored, and the third and forth must
# be string and integer respectively.  First argument is the name of the db file
#
# This is a cumulative database.  No remove functionality is implemented.
#
# format, add_user("userfile", "ignored", "user", "authlevel")
# authlevel being numeric value, ignored meaning the arg is not used
     my $self = shift;
     open( USRDB, "<$_[0]" ) or die "error opening user file: $_[0]\n";
    my @lines = ;    # Read it into an array
    close(USRDB);
# check for correct syntax
# if ($_[3] !~ /^\d+$/ or $_[2] !~ /^[A-Za-z]+$/)
if (not defined $_[3] or not defined $_[2] or $_[3] !~ /^\d+$/)
  {
   print "The  must be letters only and the  must be a number between 1 and 500\n";
   return "0 $_[2] $_[3]";

  }
  else
     {
     my $test;
        for $test (@lines)
        {
        # skip lines that are comments or blank lines
          if ($test =~ /^s*#/)
          {
            next;
          }
          if ($test =~ /^$/)
          {
            next;
          }
          # still in the for loop
# split the line up into into it's seporate values, delimited by space
          my (@words) = split(/ /, $test);
          # evaluate if the entry exists, if it does, exit the loop and give 'already exists' message
              if ($words[0] eq $_[2])
              {
                  print "The user, $words[0], already exists.\n";
                  return "1 $_[2] $_[3]";

              }
            # ok, the user didn't match, so what do we do now?
            next;
            # go to the next one, duh
            # still looping
           }
        # no longer in loop, but still else

        # the entry doesnt exist, lets make one
          print "Adding user $_[2] at authlevel $_[3].\n";

          # re-opening of the file, this time in append mode
          # doesn't seem to be too much of an IO drain, I get 0 ms execution
          # times tested up to 25mb file.  Until sockets are implemented,
          # this should be fine.
          open(USRDB, ">>$_[0]") or die "could not open $_[0] for append!\n";
          # print our data to the file
          print USRDB "$_[2] $_[3]\n";
          # close the file
          close(USRDB);
          return "2 $_[2] $_[3]";

        # still in the else meaning valid syntax with data left to handle
        # open(USRDB, ">>authuser.db");
     }
         # still in the sub, outside the else

 }
 sub add_command {
 return 0;
 }
sub authenticate {

    # format, authenticate("userfile", "commandfile", "user", "command")
    # authlevel being numeric value
    my $self = shift;
    open( USRDB, "<$_[0]" ) or die "error opening user file: $_[0]\n";
    my @users = ;    # Read it into an array
    open( CMDDB, "<$_[1]" ) or die "error opening command file: $_[1]\n";
    my @commands = ;
    close(USRDB);
    close(CMDDB);
    my $userset;
    if (not defined $ARGV[0] or not defined $ARGV[1])
    {
    print "Wrong Syntax\n";
    return "0 $_[2] $_[3]";

    }
    for $userset (@users)
    {
        if ( $userset =~ /^s*#/ )
        {
            next;
        }

        if ( $userset =~ /^$/ )
        {
            next;
        }

        my (@userlist) = split( / /, $userset );

        if ( $userlist[0] eq $_[2] )
        {
            my $command;
            for $command (@commands)
            {

                chomp($command);

                if ( $command =~ /^s*#/ )
                {
                    next;
                }
                if ( $command =~ /^$/ )
                {
                    next;
                }
                my (@cmmd) = split( / /, $command );

                if ( $cmmd[0] eq $_[3] )
                {

                    # command exists

                    if ( $userlist[1] >= $cmmd[1] )
                    {
                        if ( defined $cmmd[2] )
                        {
                        # authenticated, but what type of command?
                        if ( $cmmd[2] eq "." )
                        {
                            print "$userlist[0] authenticated for $cmmd[0] which does: @cmmd[3..$#cmmd]\n";
                            return "1.0 $_[2] $_[3] @cmmd[3..$#cmmd]";

                        }

                        else
                        {
                            if ( $cmmd[2] eq "]" )
                           {
                                print "$userlist[0] authenticated for $cmmd[0] which does: @cmmd[3..$#cmmd]\n";
                                 for ( @cmmd[ 3 .. $#cmmd ], $_[2] ) { s/[\x0A\x0D]//g; s/[\r\n]//; }
                                 return "1.1 $_[2] $_[3] @cmmd[3..$#cmmd]";

                                #print "second time @cmmd[3..$#cmmd] test\n";

                            }

                           }
                            }
                            else
                           {
                           {
                             print "$userlist[0] authenticated for $cmmd[0]\n";
                             return "1.2 $_[2] $_[3]";

                            }
                        }
                        # I'm too lazy to track down the iteration of this loop
                        # therefore, I will add this print statement...
                        # If anyone sees the following message, please report
                        # it to the author's email address.
                        print "why did this happen?\n";
                        return "0 $_[2] $_[3]";

                    }
                    print "User $_[2] Not Authenticated\n";
                    return "2 $_[2] $_[3]";

                }

                # looping through the commands
                #print "why did this happen3?\n";
            }
            print "Command $_[3] doesn't exist\n";
            return "3 $_[2] $_[3]";

        }
        next;
        return "0 $_[2] $_[3]";
    }
    print "User $_[2] doesn't exist\n";
    return "4 $_[2] $_[3]";


    #end of sub
}
# see if we can get a different timer result
print "OzDB Driver version $VERSION\n";
# set a stop timer
 my $t1 = new Benchmark;
# calculate time difference
 my $td = timediff($t1, $t0);
 print "Your OzDB Request took aproximately ", timestr($td),"\nThe results of your request are as follows:\n";

1;
__END__