view release on metacpan or  search on metacpan

lib/CGI/CRUD/TableIO.pm  view on Meta::CPAN

    }
    unless ($table->delete())
    {
        $r->server_error();
        return undef;
    }
    my $msg = qq[<P>Record Deleted</P>];
    $msg .= $self->return_results($q);
    $r->output($msg);
}

sub return_results
{
    my ($self,$fq) = @_;
    my $msg = qq[<P><TABLE WIDTH="100%"><TR>];
    my $q = CGI::AutoForm->extract_query_group($fq,'__SDAT_TAB_ACTION');
    $q->{'__SDAT_TAB_ACTION.ACTION'} = 'SD';
    my $stq = CGI::AutoForm->extract_cut_query_group($fq,'__SDAT.SC');
    my $sq = stringify_query({ %$q, %$stq });
    $msg .= qq[<TD><A HREF="$self->{action}?$sq">Return to search results<A></TD>];
    $msg .= $self->sreturn($q);
    $msg .= qq[</TR></TABLE></P>];
    return $msg;
}

sub sreturn
{
    my ($self,$q) = @_;
    my $msg;
    my $eq = CGI::AutoForm->extract_query_group($q,'__SDAT_TAB_ACTION');
    $eq->{'__SDAT_TAB_ACTION.ACTION'} = 'SR';
    my $sq = stringify_query($eq);
    $msg .= qq[<TD><A HREF="$self->{action}?$sq">New Search with $q->{'__SDAT_TAB_ACTION.TABLE_NAME'}<A></TD>];
    $eq->{'__SDAT_TAB_ACTION.ACTION'} = 'IR';
    $sq = stringify_query($eq);
    $msg .= qq[<TD><A HREF="$self->{action}?$sq">Add to $q->{'__SDAT_TAB_ACTION.TABLE_NAME'}<A></TD>];
    $eq->{'__SDAT_TAB_ACTION.RESTART'} = 1;
    $sq = stringify_query($eq);
    $msg .= qq[<TD><A HREF="$self->{action}?$sq">New DB Operation<A></TD>];
    return $msg;
}

sub new_start
{
    my ($self,$q) = @_;
    my $msg = qq[<P><TABLE WIDTH="100%"><TR>];
    $msg .= $self->sreturn($q);
    $msg .= qq[</TR></TABLE></P>];
    return $msg;
}

# Perform update operation

# special value of NULL still recognized, however its sufficient to have an empty new value
# where the existing value is not empty, this will update the value to NULL a little more risky but much more
# convenient because values of length < 4 (e.g. YORN and date elements) will have to be expanded to 4
# losing some ability to constrain the values
# THIS MEANS IT IS UP TO YOU TO REPRESENT ALL VALUES IN AN UPDATE, OTHERWISE THEY **WILL BE SET TO NULL**
# e.g. submit a full record to form->add_record and make sure field_template has *all* fields, either by
# completely relying on the data dictionary or inserting a record for all fields in UI_TABLE_COLUMN
sub update_data
{
    my ($self,$r) = @_;
    my $form = $self->update_form($r) || return undef;
    my $q = $r->query();
    my %vq = %$q;
    map { $vq{$_} =~ s/^NULL$// } keys(%vq);
    unless ($form->validate_query(\%vq,$self->{verify_input}))
    {
        $r->output($form->prepare($q));
        return OK;
    }

    my $table_name = $r->param('__SDAT_TAB_ACTION.TABLE_NAME');
    my ($table,$rec);
    my $sq = $form->format_query($q);
    unless (($table = new CGI::CRUD::Table($r->dbh(),$r->user,undef,undef,$table_name)) && ($rec = $table->fetch($sq->{__SDAT}{KEYS})))
    {
        defined($rec) && ($r->output("Record no longer exists"),return OK);
        $r->server_error();
        return undef;
    }
    my $table_dat = $sq->{uc($table_name)};

    # a special value of 'NULL' updates a value to NULL
    map { $table_dat->{$_} =~ s/^NULL$// } keys(%$table_dat);
    map { $table_dat->{$_} = '' unless exists($table_dat->{$_}) } keys(%{$table->column_types()});
    unless ($table->update($table_dat))
    {
        $r->server_error();
        return undef;
    }
    my $msg = qq[<P>Record Updated</P>];
    $msg .= $self->return_results($q);
    $r->output($msg);
}

# Build update form
sub update_form
{
    my ($self,$r) = @_;
    my $form = $r->form($r->dbh());
    my $table_name = $r->param('__SDAT_TAB_ACTION.TABLE_NAME');
    $form->heading("Update $table_name");
    $form->action($self->{action});
    $form->submit_value('Update');
    $r->graceful_add_form_group($form,'DISPLAY EDIT',$table_name,'Edit fields and submit when done') || return undef;
    return $form;
}

# Build/present update form
sub update_req
{
    my ($self,$r) = @_;
    my $form = $self->update_form($r) || return undef;
    my $q = $r->query();
    $q->{'__SDAT_TAB_ACTION.ACTION'} = 'UD';
    my $sq = $form->format_query($q);
    my ($table,$rec);
    my $table_name = $r->param('__SDAT_TAB_ACTION.TABLE_NAME');
    unless (($table = new DBIx::IO::Table($r->dbh(),undef,undef,$table_name)) && ($rec = $table->fetch($sq->{__SDAT}{KEYS})))
    {
        defined($rec) && ($r->output("Record no longer exists"),return OK);
        $r->server_error();
        return undef;
    }
    $form->add_record($rec);
    $r->output($form->prepare($q));
}

# Perform search operation and return results
sub search_results
{
    my ($self,$r) = @_;
    
    # keep in mind this is NOT normalized or unescaped
    my $q = $r->query();
    my $form = $self->search_form($r) || return undef;
    unless ($form->validate_query($q))
    {
        $r->output($form->prepare($q));
        return OK;
    }

    my $table_name = $r->param('__SDAT_TAB_ACTION.TABLE_NAME');
    $form = new CGI::AutoForm($r->dbh());
    $r->graceful_add_form_group($form,'DISPLAY ONLY',$table_name,"Searching...",undef,1) || return undef;
    $q = $form->format_query($r->query());
    my $table_dat = $q->{uc($table_name)};
    my $searcher = $self->build_search($table_dat,$table_name) or ($r->server_error(),return undef);
    my $field_list = $form->field_list();
    my $ffield;
    foreach my $f (@$field_list)
    {
        if (length($f->{BRIEF_HEADING}))
        {
            $ffield = $f->{FIELD_NAME};
            last;
        }
    }
    $searcher->sortlist([ $ffield ]);

    my $results = $searcher->search();
    unless ($results)
    {
        $r->server_error();
        return $results;
    }
    unless (@$results)
    {
        $r->output("No results found");
        return 1;