File-Tabular-Web
view release on metacpan or search on metacpan
lib/File/Tabular/Web.pm view on Meta::CPAN
#----------------------------------------------------------------------
my ($self, $start) = @_;
# need request object to invoke native param() method
my $req = $self->{req};
my @params = ("S=$self->{search_string_orig}", "start=$start");
push @params, "orderBy=$self->{orderBy}" if $req->parameters->{orderBy};
push @params, "count=$self->{count}" if $req->parameters->{count};
return @params;
}
#----------------------------------------------------------------------
sub words_queried {
#----------------------------------------------------------------------
my $self = shift;
return ($self->{search_string_orig} =~ m([\w/]+)g);
}
#----------------------------------------------------------------------
sub log_search {
#----------------------------------------------------------------------
my $self = shift;
return if not $self->{logger};
my $msg = "[$self->{search_string}] $self->{user}";
$self->{logger}->info($msg);
}
#======================================================================
# REQUEST HANDLING : UPDATE METHODS #
#======================================================================
#----------------------------------------------------------------------
sub empty_record { # to be displayed in "modif" view (when adding)
#----------------------------------------------------------------------
my ($self) = @_;
$self->can_do("add") or
die "no 'add' permission for $self->{user}";
# build a record and insert default values
my $record = $self->{data}->ht->new;
my $defaults = $self->{cfg}->get("fields_default");
if (my $auto_num = $self->{data}{autoNumField}) {
$defaults->{$auto_num} ||= $self->{data}{autoNumChar};
}
$record->{$_} = $defaults->{$_} foreach $self->{data}->headers;
$self->{results} = {count => 1, records => [$record], lineNumbers => [-1]};
}
#----------------------------------------------------------------------
sub update {
#----------------------------------------------------------------------
my ($self) = @_;
# check if there is one record to update
my $found = $self->{results};
$found->{count} == 1 or die "unexpected number of records to update";
# gather some info
my $record = $found->{records}[0];
my $line_nb = $found->{lineNumbers}[0];
my $is_adding = $line_nb == -1;
my $permission = $is_adding ? 'add' : 'modif';
# check if user has permission
$self->can_do($permission, $record)
or die "No permission '$permission' for $self->{user}";
# if adding, must make sure to read all rows so that autonum gets updated
if ($is_adding && $self->{cfg}->get('fields_autoNum')) {
while ($self->{data}->fetchrow) {}
}
# call hook before update
$self->before_update($record);
# prepare message to user
my @headers = $self->{data}->headers;
my $data_line = join("|", @{$record}{@headers});
my ($msg, $id) = $is_adding ? ("Created", $self->{data}{autoNum})
: ("Updated", $self->key($record));
$self->{msg} .= "<br>$msg:<br>"
. "<a href='?S=K_E_Y:$id'>Record $id</a>: $data_line<br>";
# do the update
my $to_delete = $is_adding ? 0 # no previous line to delete
: 1; # replace previous line
eval {$self->{data}->splices($line_nb, $to_delete, $record)} or do {
my $err = $@;
$self->rollback_update($record);
die $err;
};
# call hook after update
$self->after_update($record);
}
#----------------------------------------------------------------------
sub before_update { #
#----------------------------------------------------------------------
my ($self, $record) = @_;
# copy defined params into record ..
my $key_field = $self->param($self->key_field);
foreach my $field ($self->{data}->headers) {
my $val = $self->param($field);
next if not defined $val;
if ($field eq $key_field and $val ne $self->key($record)) {
die "supplied key $val does not match record key";
}
( run in 0.510 second using v1.01-cache-2.11-cpan-e1769b4cff6 )