view release on metacpan or  search on metacpan

HTMLinterface.pm  view on Meta::CPAN

   # Check access privs
   $self->_checkAccess;

   # Delete the record
   $self->_deleteRecord($self->{CGI}->param("HTMLinterface-table"));
}

# ------------------------------------------------------------------------
# General support functions
# ------------------------------------------------------------------------
=pod

=back

=head2 Optional Customisation Methods

Optional methods which can be called to alter the behaviour of the script
or enable features such as logging.

=over 4

=cut

=item B<set_logcallback> B<(>I<Callback function address>B<);>

  sub log_callback {
      my $description = shift;
      my $sql         = shift;

      open (LOG,">>$logfile")
      print LOG "$description (Executing $sql)";
      close(LOG);
  }
  $DBinterface = new DBIx::HTMLinterface ($cgi, $dbh, $table, 1);
  $DBinterface->set_logcallback(\&log_callback);
  $DBinterface->check_params();

Enables logging of SQL changes to the database via the user
defined routine. The first parameter passed is a description,
such as 'Record added to mytable' and the second parameter is
the SQL statement which was used.

NOTE: check_params() MUST be called or HTMLinterface will not function correctly.

=cut
sub set_logcallback {
#   $self                  &callback;
    $_[0]->{LOGCALLBACK} = $_[1];
}

=item B<set_logfile> B<(>I<Logfile name>B<);>
  $DBinterface = new DBIx::HTMLinterface ($cgi, $dbh, $table, 1);
  $DBinterface->set_logfile("/usr/local/logs/mydb-log");
  $DBinterface->check_params();

Enables logging of SQL changes to the database automatically
without providing a callback. The script will open the file
specified, with no locking (Althoughthis might be added in 
future). The file must be writeable to the CGI, on UNIX you 
normally need to I<chmod 666 mydb-log>. However this may 
differ depending on your system and what operating system 
you have.

NOTE: check_params() MUST be called or HTMLinterface will not function correctly.

=cut
sub set_logfile {
#   $self              $logfile;
    $_[0]->{LOGFILE} = $_[1];
}

# Internal function to log output if logging is enabled
sub _logEvent {
    my $self    = shift;
    my $cmd     = shift;
    my $sql     = shift;
    my $logfile = undef;

    # If we have a callback, use it
    if (defined $self->{LOGCALLBACK}) {
        &{$self->{LOGCALLBACK}} ($cmd, $sql);
        return;

    # Else output to a logfile ourselves
    } elsif (defined $self->{LOGFILE}) {
        $logfile = $self->{LOGFILE};

    # Else forget logging
    } else {
        return;

    }

    # Get and format the time
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
	if ($sec < 10) { $sec = "0$sec"; }
	if ($min < 10) { $min = "0$min"; }
	if ($hour < 10) { $hour = "0$hour"; }
	if ($mon < 10) { $mon = "0$mon"; }
	if ($mday < 10) { $mday = "0$mday"; }
    my (@months) = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");
    my ($cur_date) = "[" . $mday . "/" . $months[$mon] . "/" . $year . ":" . $hour . ":" . $min . ":" . $sec . " +0000]";

    # Open the logfile for append
	if (! open(LOG,">>$logfile")) {
        # Send warnings to the browser and STDERR on failure
        warn ("Unable to open logfile $logfile for append ($!)");
        print "<B>WARNING</B>: Unable to open logfile $logfile for append ($!)";
		return;
	}

    # Print to the logfile
    print LOG "$cur_date $cmd" . ($sql ne "" ? " SQL: '$sql'" : "") . "\n";

    # Close the logfile
    close (LOG);
}

=item B<set_errhandler> B<(>I<Error handler function address>B<);>