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 )