DBIx-HTMLinterface

 view release on metacpan or  search on metacpan

HTMLinterface.pm  view on Meta::CPAN

            my ($name, $value) = split(/=/, $pair);
            $extrahash{$name}  = $value;
        }

        # Load hidden array
        $hashInfo    = $entry->{"Hidden"};
        @hidden      = split(/&/, $hashInfo);

        # Load exclude array
        $hashInfo    = $entry->{"Exclude"};
        @exclude     = split(/&/, $hashInfo);

        # Load table name
        $additionalwhere = $entry->{"AdditionalWhere"};
    }

    $cursor->finish;
    return ($table_name, \%namehash, \%labelhash, \%lookuphash, \%extrahash, \@hidden, \@exclude, $additionalwhere);
}

# Internal function to return a hash of just the extra data from the info table
sub _getTableExtraHash {
    my $self    = shift;
    my $table   = shift;

    my $cursor = $self->_execSql ('select ExtraHash from ' . $self->{ITABLE} . ' where TableID = ' . $self->_sqlQuote($table));
    my ($entry, %hash);

    # Don't die on fail - simply return an empty hash and default everything
    # TODO: Protect against undefined tables for this
    if ($entry = $cursor->fetchrow_hashref) {
        my $hashInfo    = $entry->{"ExtraHash"};

        my @pairs       = split(/&/, $hashInfo);
        my $pair;

        foreach $pair (@pairs) {
            my ($name, $value) = split(/=/, $pair);

            $hash{$name} = $value;
        }
    }

    $cursor->finish;
    return \%hash;
}

# Internal function to execute a SQL modify
sub _modifyRecord {
    my $self    = shift;
    my $table   = shift;

    # Run the SQL
    my $sql = $self->_updateSql ($table);
    my $cursor = $self->_execSql ($sql);
    $cursor->finish;

    # Tell the people what we did
    $self->_printHeader('Modification Successful', 'Record modified successfully.');
    print "<UL>";
    print "<LI><A HREF=\"" . $self->_backLink . "\">Main Menu</A>";
    print "</UL>";
    $self->_printFooter;

    # Log it, if logging is enabled
    $self->_logEvent("Record modified from $table", $sql);
}

# Internal function to execute a SQL delete
sub _deleteRecord {
    my $self    = shift;
    my $table   = shift;

    # Require confirmation of the delete
	if ($self->{CGI}->param('confirm')) {
        # Run the SQL
        my $sql = $self->_deleteSql($table);
        my $cursor = $self->_execSql ($sql);
        $cursor->finish;

        # Tell the people what we did
        $self->_printHeader('Deletion Successful', 'Record deleted successfully.');
        print "<UL>";
        print "<LI><A HREF=\"" . $self->_backLink . "\">Main Menu</A>";
        print "</UL>";
        $self->_printFooter;

        # Log it, if logging is enabled
        $self->_logEvent("Record deleted from $table", $sql);
	} else {
        # Ask them to confirm their action
        $self->_printHeader('Confirm Delete', 'Confirm Delete');
        print $self->{CGI}->b('Press back to cancel. Press Confirm to delete.');
        print $self->{CGI}->startform;
        $self->_printHidden; # Print any hidden elements necessary

        # Print all the form params as hidden fields
        my @form = $self->{CGI}->param;
        my $name;
		while ($name = shift @form) {
            print $self->{CGI}->hidden (-name=>$name, -value=>$self->{CGI}->param ($name) );
		}

        print $self->{CGI}->hidden(-name=>'confirm',-value =>'true');
        print $self->{CGI}->submit('Confirm');
        print "&nbsp;&nbsp;&nbsp;";
        print $self->_backLink;
        print $self->{CGI}->endform;
        $self->_printFooter;
	}
}

# Internal function to execute a SQL insert
sub _insertRecord {
    my $self    = shift;
    my $table   = shift;

    # Run the SQL
    my $sql = $self->_insertSql ($table);
    my $cursor = $self->_execSql ($sql);
    $cursor->finish;

    # Tell the people what we did
    $self->_printHeader('Addition Successful', 'Record added successfully.');
    print "<UL>";
    print "<LI><A HREF=\"" . $self->_repeatLink . "\">Add Another</A>";
    print "<LI><A HREF=\"" . $self->_backLink . "\">Main Menu</A>";
    print "</UL>";
    $self->_printFooter;

    # Log it, if logging is enabled
    $self->_logEvent("Record added to $table", $sql);
}

# _insertSql - internal function to generate insert statements for $table, inserting all values in
# $self->{CGI}->param which match the table column names.
sub _insertSql {
    my $self            = shift;
    my $table           = shift;

    # Use a DESCRIBE statement to get the field default values
    my $desc_cursor = $self->_execSql ("describe $table");
    my (@fields, @fielddefaults, @fieldextra, @fielddesc);
# TODO: Lousy hack?
    my $fieldextra2 = _getTableExtraHash($self,$table); # Get extra info from the infotable
    while (@fielddesc = $desc_cursor->fetchrow) {
		push @fields, $fielddesc[0];
		push @fielddefaults, $fielddesc[4];
		push @fieldextra, $fielddesc[5];
	}
    $desc_cursor->finish;

    my $first_time = 1;
    my ($field, $default, $extra);

    # Start the SQL statement
    my $sql = "insert into $table values (";

    # Step through the fields and add a section to the statement for each
    while ($field   = shift @fields) {
        $default    = shift @fielddefaults;
        $extra      = shift @fieldextra;

        # Convert NULL fields to "" unless they are auto incrementing in which case
        # leave them as NULL to allow the auto increment to function
        $default    = $default eq "NULL" ? "" : $default;
		if ($extra eq "auto_increment") {
			$default = "NULL";
		}

        # Get the value if we have a CGI-specified value, else use the default
        my $val     = $self->{CGI}->param("$field") || $default;

        # Add commas between statements
        if ($first_time != 1) {
			$sql .= ', ';
		}

        # Encrypt passwords if required, then add the value to the statement
        if ($$fieldextra2{$field} eq "encryptpassword") {
            $sql .= "PASSWORD(" . $self->_sqlQuote($val) . ")";
		} else {
            $sql .= $self->_sqlQuote($val);
		}

		$first_time = 0;
	}



( run in 0.882 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )