$main::lxdebug->enter_sub();
my ($self, $myconfig, $form, $prefix) = @_;
+ $prefix ||= '';
my $dbh = $form->get_standard_dbh;
my $self = shift;
$session_id = $::request->{cgi}->cookie($self->get_session_cookie_name());
- $session_id =~ s|[^0-9a-f]||g;
+ $session_id =~ s|[^0-9a-f]||g if $session_id;
$self->{SESSION} = { };
$amount{ $ref->{accno} } = $ref->{amount};
}
- my $where = "AND c.id = $chart_id" if ($chart_id ne '');
+ my $where = $chart_id ne '' ? "AND c.id = $chart_id" : '';
$query = qq{
SELECT
$intnotes .= "\n\n" if ($intnotes);
- my $cc = $main::locale->text('Cc') . ": $form->{cc}\n" if $form->{cc};
- my $bcc = $main::locale->text('Bcc') . ": $form->{bcc}\n" if $form->{bcc};
+ my $cc = $form->{cc} ? $main::locale->text('Cc') . ": $form->{cc}\n" : '';
+ my $bcc = $form->{bcc} ? $main::locale->text('Bcc') . ": $form->{bcc}\n" : '';
my $now = scalar localtime;
$intnotes .= $main::locale->text('[email]') . "\n"
--- /dev/null
+package SL::Controller::Helper::ParseFilter;
+
+use strict;
+
+use Exporter qw(import);
+our @EXPORT = qw(parse_filter);
+
+use DateTime;
+use SL::Helper::DateTime;
+use List::MoreUtils qw(uniq);
+use Data::Dumper;
+
+my %filters = (
+ date => sub { DateTime->from_lxoffice($_[0]) },
+ number => sub { $::form->parse_amount(\%::myconfig, $_[0]) },
+ percent => sub { $::form->parse_amount(\%::myconfig, $_[0]) / 100 },
+ head => sub { $_[0] . '%' },
+ tail => sub { '%' . $_[0] },
+ substr => sub { '%' . $_[0] . '%' },
+);
+
+my %methods = (
+ lt => sub { +{ lt => $_[0] } },
+ gt => sub { +{ gt => $_[0] } },
+ ilike => sub { +{ ilike => $_[0] } },
+ like => sub { +{ like => $_[0] } },
+ enable => sub { ;;;; },
+);
+
+sub parse_filter {
+ my ($filter, %params) = @_;
+
+ my $hint_objects = $params{with_objects} || [];
+
+ my ($flattened, $objects) = _pre_parse($filter, $hint_objects, '', %params);
+
+ my $query = _parse_filter($flattened, %params);
+
+ _launder_keys($filter) unless $params{no_launder};
+
+ return
+ ($query && @$query ? (query => $query) : ()),
+ ($objects && @$objects ? ( with_objects => [ uniq @$objects ]) : ());
+}
+
+sub _launder_keys {
+ my ($filter) = @_;
+ return unless ref $filter eq 'HASH';
+ my @keys = keys %$filter;
+ for my $key (@keys) {
+ my $orig = $key;
+ $key =~ s/:/_/g;
+ $filter->{$key} = $filter->{$orig};
+ _launder_keys($filter->{$key});
+ };
+
+ return $filter;
+}
+
+sub _pre_parse {
+ my ($filter, $with_objects, $prefix, %params) = @_;
+
+ return () unless 'HASH' eq ref $filter;
+ $with_objects ||= [];
+
+ my @result;
+
+ while (my ($key, $value) = each %$filter) {
+ next if !defined $value || $value eq ''; # 0 is fine
+ if ('HASH' eq ref $value) {
+ my ($query, $more_objects) = _pre_parse($value, $with_objects, _prefix($prefix, $key));
+ push @result, @$query if $query;
+ push @$with_objects, $key, ($more_objects ? @$more_objects : ());
+ } else {
+ push @result, _prefix($prefix, $key) => $value;
+ }
+ }
+
+ return \@result, $with_objects;
+}
+
+sub _parse_filter {
+ my ($flattened, %params) = @_;
+
+ return () unless 'ARRAY' eq ref $flattened;
+
+ my %sorted = ( @$flattened );
+
+ my @keys = sort { length($b) <=> length($a) } keys %sorted;
+ for my $key (@keys) {
+ next unless $key =~ /^(.*\b)::$/;
+ $sorted{$1 . '::' . delete $sorted{$key} } = delete $sorted{$1} if $sorted{$1} && $sorted{$key};
+ }
+
+ my %result;
+ while (my ($key, $value) = each %sorted) {
+ ($key, $value) = _apply_all($key, $value, qr/\b:(\w+)/, { %filters, %{ $params{filters} || {} } });
+ ($key, $value) = _apply_all($key, $value, qr/\b::(\w+)/, { %methods, %{ $params{methods} || {} } });
+ $result{$key} = $value;
+ }
+ return [ %result ];
+}
+
+sub _prefix {
+ join '.', grep $_, @_;
+}
+
+sub _apply {
+ my ($value, $name, $filters) = @_;
+ return $value unless $name && $filters->{$name};
+ return [ map { _apply($_, $name, $filters) } @$value ] if 'ARRAY' eq ref $value;
+ return $filters->{$name}->($value);
+}
+
+sub _apply_all {
+ my ($key, $value, $re, $subs) = @_;
+
+ while ($key =~ s/$re//) {
+ $value = _apply($value, $1, $subs);
+ }
+
+ return $key, $value;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+SL::Controller::Helper::ParseFilter - Convert a form filter spec into a RDBO get_all filter
+
+=head1 SYNOPSIS
+
+ use SL::Controller::Helper::ParseFilter;
+ SL::DB::Object->get_all(parse_filter($::form->{filter}));
+
+ # or more complex
+ SL::DB::Object->get_all(parse_filter($::form->{filter},
+ with_objects => [ qw(part customer) ]));
+
+=head1 DESCRIPTION
+
+A search filter will usually search for things in relations of the actual
+search target. A search for sales orders may be filtered by the name of the
+customer. L<Rose::DB::Object> alloes you to search for these by filtering them prefixed with their table:
+
+ query => [
+ 'customer.name' => 'John Doe',
+ 'department.description' => [ ilike => '%Sales%' ],
+ 'orddate' => [ lt => DateTime->today ],
+ ]
+
+Unfortunately, if you specify them in you form as these strings, the form
+parser will convert them into nested structures like this:
+
+ $::form = bless {
+ filter => {
+ customer => {
+ name => 'John Doe',
+ },
+ },
+ }, Form;
+
+And the substring match requires you to recognize the ilike, and modify the value.
+
+C<parse_filter> tries to ease this by recognizing these structures and
+providing suffixes for common search patterns.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item C<parse_filter \%FILTER, [ %PARAMS ]>
+
+First argument is the filter from form. It is highly recommended that you put
+all filter attributes into a named container as to not confuse them with the
+rest of your form.
+
+Nested structures will be parsed and interpreted as foreign references. For
+example if you search for L<Order>s, this input will search for those with a
+specific L<Salesman>:
+
+ [% L.select_tag('filter.salesman.id', ...) %]
+
+Additionally you can add modifier to the name to set a certain method:
+
+ [% L.input_tag('filter.department.description:substr::ilike', ...) %]
+
+This will add the "% .. %" wildcards for substr matching in SQL, and add an
+C<< ilike => $value >> block around it to match case insensitively.
+
+As a rule all value filters require a single colon and must be placed before
+match method suffixes, which are appended with 2 colons. See below for a full
+list of modifiers.
+
+The reason for the method being last is that it is possible to specify the
+method in another input. Suppose you want a date input and a separate
+before/after/equal select, you can use the following:
+
+ [% L.date_tag('filter.appointed_date:date', ... ) %]
+
+and later
+
+ [% L.select_tag('filter.appointed_date::', ... ) %]
+
+The special empty method will be used to set the method for the previous
+method-less input.
+
+=item Laundering filter
+
+Unfortunately Template cannot parse the postfixes if you want to
+rerender the filter. For this reason all colons filter keys are by
+default laundered into underscores. If you don't want this to happen
+pass C<< no_launder => 1 >> as a parameter. A full select_tag then
+loks like this:
+
+ [% L.input_tag('filter.price:number::lt', filter.price_number__lt) %]
+
+
+=back
+
+=head1 FILTERS (leading with :)
+
+The following filters are built in, and can be used.
+
+=over 4
+
+=item date
+
+Parses the input string with C<< DateTime->from_lxoffice >>
+
+=item number
+
+Pasres the input string with C<< Form->parse_amount >>
+
+=item percent
+
+Parses the input string with C<< Form->parse_amount / 100 >>
+
+=item head
+
+Adds "%" at the end of the string.
+
+=item tail
+
+Adds "%" at the end of the string.
+
+=item substr
+
+Adds "% .. %" around the search string.
+
+=back
+
+=head2 METHODS (leading with ::)
+
+=over 4
+
+=item lt
+
+=item gt
+
+=item ilike
+
+=item like
+
+All these are recognized like the L<Rose::DB::Object> methods.
+
+=back
+
+=head1 BUGS AND CAVEATS
+
+This will not properly handle multiple versions of the same object in different
+context.
+
+Suppose you want all L<SL::DB::Order>s which have either themselves a certain
+customer, or are linked to a L<SL::DB::Invoice> with this customer, the
+following will not work as you expect:
+
+ # does not work!
+ L.input_tag('customer.name:substr::ilike', ...)
+ L.input_tag('invoice.customer.name:substr::ilike', ...)
+
+This will sarch for orders whoe invoice has the _same_ customer, which matches
+both inputs. This is because tables are aliased by their name and not by their
+position in with_objects.
+
+=head1 TODO
+
+=over 4
+
+=item *
+
+Additional filters shoud be pluggable.
+
+=back
+
+=head1 AUTHOR
+
+Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
+
+=cut
push @values, $form->{accnoto};
}
- my $where_str = ' WHERE ' . join(' AND ', map { "($_)" } @where) if (scalar @where);
+ my $where_str = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
my $query = qq|SELECT c.accno, c.description
FROM chart c
sub _make_sort_spec {
my ($class) = @_;
- my %sort_spec = $class->_sort_spec if defined &{ "${class}::_sort_spec" };
+ my %sort_spec = defined &{ "${class}::_sort_spec" } ? $class->_sort_spec : ();
my $meta = $class->object_class->meta;
'to_table' => 'delivery_orders',
'to_id' => $params{do_id});
- my ($oe_id) = $links[0]->{from_id} if (scalar @links);
+ my $oe_id = @links ? $links[0]->{from_id} : undef;
return $main::lxdebug->leave_sub() if (!$oe_id);
$key = $params;
}
- my $where = ' WHERE ' . join(' AND ', map { "($_)" } @where) if (@where);
+ my $where = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|;
my $options = ref $key eq 'HASH' ? $key : { key => $key };
$options->{key} ||= "all_customers";
- my $limit_clause = "LIMIT $options->{limit}" if $options->{limit};
+ my $limit_clause = $options->{limit} ? "LIMIT $options->{limit}" : '';
my @where;
push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if $options->{business_is_salesman};
$extension = 'xls';
}
- my $printer_code = '_' . $self->{printer_code} if $self->{printer_code};
- my $email_extension = '_email' if -f "$self->{templates}/$self->{formname}_email${language}${printer_code}.${extension}";
+ my $printer_code = $self->{printer_code} ? '_' . $self->{printer_code} : '';
+ my $email_extension = -f "$::myconfig{templates}/$self->{formname}_email${language}.${extension}" ? '_email' : '';
$self->{IN} = "$self->{formname}${email_extension}${language}${printer_code}.${extension}";
# Format dates.
my $select_clause = join ', ', map { $token_builder->($_, 1) } @select_tokens;
my $join_clause = join ' ', @joins{ grep $joins_needed{$_}, @join_order };
my $where_clause = join ' AND ', map { "($_)" } @where_tokens;
- my $group_clause = ' GROUP BY ' . join ', ', map { $token_builder->($_) } @group_tokens if scalar @group_tokens;
+ my $group_clause = @group_tokens ? ' GROUP BY ' . join ', ', map { $token_builder->($_) } @group_tokens : '';
my %oe_flag_to_cvar = (
bought => 'invoice',
my ($sth, $ref, $query);
- my $query_transdate = ", current_date AS invdate" if !$form->{id};
+ my $query_transdate = !$form->{id} ? ", current_date AS invdate" : '';
$query =
qq|SELECT
}
if ($form->{periodic_invoices_active} ne $form->{periodic_invoices_inactive}) {
- my $not = 'NOT' if ($form->{periodic_invoices_inactive});
+ my $not = $form->{periodic_invoices_inactive} ? 'NOT' : '';
$query .= qq| AND ${not} COALESCE(pcfg.active, 'f')|;
}
}
- my $where = 'WHERE ' . join(' AND ', map { "($_)" } @filters) if (scalar @filters);
+ my $where = @filters ? 'WHERE ' . join(' AND ', map { "($_)" } @filters) : '';
my $sortorder = $params{sort} ? $params{sort} : "projectnumber";
$sortorder =~ s/[^a-z_]//g;
add_token(\@where_tokens, \@where_values, col => $col, val => $params{$col}) if $params{$col};
}
- my $where = "WHERE ". join ' AND ', map { "($_)" } @where_tokens if scalar @where_tokens;
+ my $where = @where_tokens ? "WHERE ". join ' AND ', map { "($_)" } @where_tokens : '';
my $query = "DELETE FROM record_links $where";
do_query($form, $dbh, $query, @where_values);
my $font_height = $font_size + 2 * $padding;
my $title_font_height = $font_size + 2 * $padding;
- my $header_height = 2 * $title_font_height if ($opts->{title});
- my $footer_height = 2 * $font_height if ($pdfopts->{number});
+ my $header_height = $opts->{title} ? 2 * $title_font_height : undef;
+ my $footer_height = $pdfopts->{number} ? 2 * $font_height : undef;
my $top_text_height = 0;
push @where, 'se.vc = ?';
push @values, $vc;
- my $where = ' WHERE ' . join(' AND ', map { "(${_})" } @where) if (@where);
+ my $where = @where ? ' WHERE ' . join(' AND ', map { "(${_})" } @where) : '';
my $query =
qq|SELECT se.id, se.employee_id, se.executed, se.closed, itime::date AS export_date,
my $attribute = $arg_ref->{attribute}; #
my $dec_places = (defined $arg_ref->{dec_places}) ? $arg_ref->{dec_places}:undef;
- my $where_type = "AND tax.report_headings.type = '$type'" if ( $type );
- my $where_dcp = "AND tax.report_variables.dec_places = '$dec_places'" if ( defined $dec_places );
+ my $where_type = $type ? "AND tax.report_headings.type = '$type'" : '';
+ my $where_dcp = defined $dec_places ? "AND tax.report_variables.dec_places = '$dec_places'" : '';
my $query = qq|
SELECT $attribute
$sort_order = $filter{order} unless $sort_order;
my $sort_spec = "${sort_col} " . ($sort_order ? " DESC" : " ASC");
- my $where_clause = join(" AND ", @filter_ary) . " AND " if (@filter_ary);
+ my $where_clause = @filter_ary ? join(" AND ", @filter_ary) . " AND " : '';
$select_tokens{'trans'} = {
"parts_id" => "i1.parts_id",
my $dbh = $form->dbconnect(\%myconfig);
- my $restriction = qq| AND (| . join(' OR ', map { " addition = " . $dbh->quote($_) } split(m/\,/, $form->{einschraenkungen})) . qq|)| if $form->{einschraenkungen};
+ my $restriction;
+ $restriction = qq| AND (| . join(' OR ', map { " addition = " . $dbh->quote($_) } split(m/\,/, $form->{einschraenkungen})) . qq|)| if $form->{einschraenkungen};
$restriction .= qq| AND h.itime::date >= | . conv_dateq($form->{fromdate}) if $form->{fromdate};
$restriction .= qq| AND h.itime::date <= | . conv_dateq($form->{todate}) if $form->{todate};
if ($form->{mitarbeiter} =~ m/^\d+$/) {
my $notes =
qq|<textarea name=notes rows=$rows cols=50 wrap=soft $readonly>$form->{notes}</textarea>|;
- my $department = qq|
+ my $department;
+ $department = qq|
<tr>
<th align="right" nowrap>| . $locale->text('Department') . qq|</th>
<td colspan=3><select name=department>$form->{selectdepartment}</select>
} (@{ $form->{all_departments} || [] });
}
- my $department = qq|
+ my $department;
+ $department = qq|
<tr>
<th align=right nowrap>| . $locale->text('Department') . qq|</th>
<td colspan=3><select name=department>$form->{selectdepartment}</select></td>
my $projectnumber_hidden = qq|
<input type="hidden" name="project_id_$i" value="$form->{"project_id_$i"}">|;
- my $copy2credit = 'onkeyup="copy_debit_to_credit()"' if $i == 1;
+ my $copy2credit = $i == 1 ? 'onkeyup="copy_debit_to_credit()"' : '';
print qq|<tr valign=top>
$accno
$form->{title} = $locale->text("$title General Ledger Transaction");
my $readonly = ($form->{id}) ? "readonly" : "";
- my $show_details_checked = "checked" if $form->{show_details};
-
- my $ob_transaction_checked = "checked" if $form->{ob_transaction};
- my $cb_transaction_checked = "checked" if $form->{cb_transaction};
+ my $show_details_checked = $form->{show_details} ? "checked" : '';
+ my $ob_transaction_checked = $form->{ob_transaction} ? "checked" : '';
+ my $cb_transaction_checked = $form->{cb_transaction} ? "checked" : '';
# $locale->text('Add General Ledger Transaction')
# $locale->text('Edit General Ledger Transaction')
} else {
if ($form->{draft_id}) {
- my $remove_draft_checked = 'checked' if ($form->{remove_draft});
+ my $remove_draft_checked = $form->{remove_draft} ? 'checked' : '';
print qq|<p>\n|
. qq| <input name="remove_draft" id="remove_draft" type="checkbox" class="checkbox" ${remove_draft_checked}>|
. qq| <label for="remove_draft">| . $locale->text('Remove Draft') . qq|</label>\n|
my %subtotals = map { $_ => 0 } ('onhand', @subtotal_columns);
my %totals = map { $_ => 0 } @subtotal_columns;
my $idx = 0;
- my $same_item = $form->{parts}[0]{ $form->{sort} } if (scalar @{ $form->{parts} });
+ my $same_item = @{ $form->{parts} } ? $form->{parts}[0]{ $form->{sort} } : undef;
my $defaults = AM->get_defaults();
# calculate onhand
if ($form->{"id_$i"}) {
my $part = IC->get_basic_part_info(id => $form->{"id_$i"});
- my $onhand_color = 'color="#ff0000"' if $part->{onhand} < $part->{rop};
+ my $onhand_color = $part->{onhand} < $part->{rop} ? 'color="#ff0000"' : '';
push @ROW2, { value => sprintf "<b>%s</b> <font %s>%s %s</font>",
$locale->text('On Hand'),
$onhand_color,
$extension = 'xls';
}
- my $email_extension = '_email' if (($form->{media} eq 'email') && (-f "$myconfig{templates}/$form->{formname}_email$form->{language}${printer_code}.${extension}"));
+ my $email_extension = (($form->{media} eq 'email') && (-f "$myconfig{templates}/$form->{formname}_email$form->{language}${printer_code}.${extension}")) ? '_email' : '';
$form->{IN} = "$form->{formname}${email_extension}$form->{language}${printer_code}.${extension}";
$form->{exchangerate} = $form->parse_amount(\%myconfig, $form->{exchangerate}) unless $recursive_call;
$form->{print_and_post} = 0 if $form->{second_run};
- my $taxincluded = "checked" if $form->{taxincluded};
+ my $taxincluded = $form->{taxincluded} ? "checked" : '';
$form->{update} = 1;
&check_name("customer");
$form->{quodate} = $form->{transdate};
}
- my $payment_id = $form->{payment_id} if $form->{payment_id};
+ my $payment_id;
+ if ($form->{payment_id}) {
+ $payment_id = $form->{payment_id};
+ }
# if the name changed get new values
if (&check_name($form->{vc})) {
# end of main
sub add {
- $main::lxdebug->enter_sub();
+ $::lxdebug->enter_sub;
+ $::auth->assert('config');
- $main::auth->assert('config');
+ $::form->{title} = "Add";
+ $::form->{callback} ||= "$::form->{script}?action=add&type=$::form->{type}";
- my $form = $main::form;
+ call_sub("form_$::form->{type}");
- $form->{title} = "Add";
-
- # construct callback
- $form->{callback} =
- "$form->{script}?action=add&type=$form->{type}"
- unless $form->{callback};
-
- call_sub("form_$form->{type}_header");
- call_sub("form_$form->{type}_footer");
-
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
}
sub edit {
- $main::lxdebug->enter_sub();
+ $::lxdebug->enter_sub;
+ $::auth->assert('config');
- $main::auth->assert('config');
+ $::form->{title} = "Edit";
- my $form = $main::form;
- my %myconfig = %main::myconfig;
-
- # show history button
- $form->{javascript} = qq|<script type="text/javascript" src="js/show_history.js"></script>|;
- #/show hhistory button
- $form->{title} = "Edit";
-
- if ($form->{type} eq 'partsgroup') {
- PE->get_partsgroup(\%myconfig, \%$form);
+ if ($::form->{type} eq 'partsgroup') {
+ PE->get_partsgroup(\%::myconfig, $::form);
}
- if ($form->{type} eq 'pricegroup') {
- PE->get_pricegroup(\%myconfig, \%$form);
+ if ($::form->{type} eq 'pricegroup') {
+ PE->get_pricegroup(\%::myconfig, $::form);
}
- call_sub("form_$form->{type}_header");
- call_sub("form_$form->{type}_footer");
+ call_sub("form_$::form->{type}");
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
}
sub search {
- $main::lxdebug->enter_sub();
-
- $main::auth->assert('config');
-
- my $form = $main::form;
- my $locale = $main::locale;
-
- my ($report, $sort, $number);
- if ($form->{type} eq 'partsgroup') {
- $report = "partsgroup_report";
- $sort = 'partsgroup';
- $form->{title} = $locale->text('Groups');
-
- $number = qq|
- <tr>
- <th align=right width=1%>| . $locale->text('Group') . qq|</th>
- <td><input name=partsgroup size=20></td>
- </tr>
-|;
-
- }
-
- # for pricesgroups
- if ($form->{type} eq 'pricegroup') {
- $report = "pricegroup_report";
- $sort = 'pricegroup';
- $form->{title} = $locale->text('Pricegroup');
+ $::lxdebug->enter_sub;
+ $::auth->assert('config');
- $number = qq|
- <tr>
- <th align=right width=1%>| . $locale->text('Pricegroup') . qq|</th>
- <td><input name=pricegroup size=20></td>
- </tr>
-|;
+ $::form->header;
+ print $::form->parse_html_template('pe/search', {
+ is_pricegroup => $::form->{type} eq 'pricegroup',
+ });
- }
-
- $form->header;
-
- print qq|
-<body>
-
-<form method=post action=$form->{script}>
-
-<input type=hidden name=sort value=$sort>
-<input type=hidden name=type value=$form->{type}>
-
-<table width=100%>
- <tr>
- <th class=listtop>$form->{title}</th>
- </tr>
- <tr height="5"></tr>
- <tr>
- <td>
- <table width=100%>
- $number
- <tr>
- <td></td>
- <td><input name=status class=radio type=radio value=all checked> | . $locale->text('All') . qq|
- <input name=status class=radio type=radio value=orphaned> | . $locale->text('Orphaned') . qq|</td>
- </tr>
- </table>
- </td>
- </tr>
- <tr>
- <td><hr size=3 noshade></td>
- </tr>
-</table>
-
-<input type=hidden name=nextsub value=$report>
-
-<br>
-<input class=submit type=submit name=action value="|
- . $locale->text('Continue') . qq|">
-</form>
-
-</body>
-</html>
-|;
-
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
}
sub save {
- $main::lxdebug->enter_sub();
-
- $main::auth->assert('config');
+ $::lxdebug->enter_sub;
+ $::auth->assert('config');
- my $form = $main::form;
- my %myconfig = %main::myconfig;
- my $locale = $main::locale;
-
- if ($form->{type} eq 'partsgroup') {
- $form->isblank("partsgroup", $locale->text('Group missing!'));
- PE->save_partsgroup(\%myconfig, \%$form);
- $form->redirect($locale->text('Group saved!'));
+ if ($::form->{type} eq 'partsgroup') {
+ $::form->isblank("partsgroup", $::locale->text('Group missing!'));
+ PE->save_partsgroup(\%::myconfig, $::form);
+ $::form->redirect($::locale->text('Group saved!'));
}
# choice pricegroup and save
- if ($form->{type} eq 'pricegroup') {
- $form->isblank("pricegroup", $locale->text('Pricegroup missing!'));
- PE->save_pricegroup(\%myconfig, \%$form);
- $form->redirect($locale->text('Pricegroup saved!'));
+ if ($::form->{type} eq 'pricegroup') {
+ $::form->isblank("pricegroup", $::locale->text('Pricegroup missing!'));
+ PE->save_pricegroup(\%::myconfig, $::form);
+ $::form->redirect($::locale->text('Pricegroup saved!'));
}
# saving the history
- if(!exists $form->{addition} && $form->{id} ne "") {
- $form->{snumbers} = qq|projectnumber_| . $form->{projectnumber};
- $form->{addition} = "SAVED";
- $form->save_history;
+ if(!exists $::form->{addition} && $::form->{id} ne "") {
+ $::form->{snumbers} = qq|projectnumber_| . $::form->{projectnumber};
+ $::form->{addition} = "SAVED";
+ $::form->save_history;
}
# /saving the history
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
}
sub delete {
- $main::lxdebug->enter_sub();
-
- $main::auth->assert('config');
-
- my $form = $main::form;
- my %myconfig = %main::myconfig;
- my $locale = $main::locale;
+ $::lxdebug->enter_sub;
+ $::auth->assert('config');
- PE->delete_tuple(\%myconfig, \%$form);
+ PE->delete_tuple(\%::myconfig, $::form);
- if ($form->{type} eq 'partsgroup') {
- $form->redirect($locale->text('Group deleted!'));
+ if ($::form->{type} eq 'partsgroup') {
+ $::form->redirect($::locale->text('Group deleted!'));
}
- if ($form->{type} eq 'pricegroup') {
- $form->redirect($locale->text('Pricegroup deleted!'));
+ if ($::form->{type} eq 'pricegroup') {
+ $::form->redirect($::locale->text('Pricegroup deleted!'));
}
# saving the history
- if(!exists $form->{addition}) {
- $form->{snumbers} = qq|projectnumber_| . $form->{projectnumber};
- $form->{addition} = "DELETED";
- $form->save_history;
+ if(!exists $::form->{addition}) {
+ $::form->{snumbers} = qq|projectnumber_| . $::form->{projectnumber};
+ $::form->{addition} = "DELETED";
+ $::form->save_history;
}
# /saving the history
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
}
-sub continue { call_sub($main::form->{"nextsub"}); }
+sub continue { call_sub($::form->{nextsub}); }
sub partsgroup_report {
- $main::lxdebug->enter_sub();
+ $::lxdebug->enter_sub;
+ $::auth->assert('config');
- $main::auth->assert('config');
+ $::form->{$_} = $::form->unescape($::form->{$_}) for qw(partsgroup);
+ PE->partsgroups(\%::myconfig, $::form);
- my $form = $main::form;
- my %myconfig = %main::myconfig;
- my $locale = $main::locale;
+ my $callback = build_std_url("action=partsgroup_report", qw(type status));
- map { $form->{$_} = $form->unescape($form->{$_}) } qw(partsgroup);
- PE->partsgroups(\%myconfig, \%$form);
+ my $option = '';
+ $option .= $::locale->text('All') if $::form->{status} eq 'all';
+ $option .= $::locale->text('Orphaned') if $::form->{status} eq 'orphaned';
- my $callback =
- "$form->{script}?action=partsgroup_report&type=$form->{type}&status=$form->{status}";
-
- my ($option);
- if ($form->{status} eq 'all') {
- $option = $locale->text('All');
- }
- if ($form->{status} eq 'orphaned') {
- $option .= $locale->text('Orphaned');
- }
- if ($form->{partsgroup}) {
- $callback .= "&partsgroup=$form->{partsgroup}";
- $option .= "\n<br>" . $locale->text('Group') . " : $form->{partsgroup}";
+ if ($::form->{partsgroup}) {
+ $callback .= "&partsgroup=$::form->{partsgroup}";
+ $option .= ", " . $::locale->text('Group') . " : $::form->{partsgroup}";
}
- my @column_index = $form->sort_columns(qw(partsgroup));
- my %column_header;
- $column_header{partsgroup} =
- qq|<th class=listheading width=90%>| . $locale->text('Group') . qq|</th>|;
-
- $form->{title} = $locale->text('Groups');
-
- $form->header;
-
- print qq|
-<body>
-
-<table width=100%>
- <tr>
- <th class=listtop>$form->{title}</th>
- </tr>
- <tr height="5"></tr>
- <tr>
- <td>$option</td>
- </tr>
- <tr>
- <td>
- <table width=100%>
- <tr class=listheading>
-|;
-
- map { print "$column_header{$_}\n" } @column_index;
-
- print qq|
- </tr>
-|;
-
# escape callback
- $form->{callback} = $callback;
-
- # escape callback for href
- $callback = $form->escape($callback);
-
- my ($i, %column_data);
- foreach my $ref (@{ $form->{item_list} }) {
-
- $i++;
- $i %= 2;
-
- print qq|
- <tr valign=top class=listrow$i>
-|;
-
- $column_data{partsgroup} =
- qq|<td><a href=$form->{script}?action=edit&type=$form->{type}&status=$form->{status}&id=$ref->{id}&callback=$callback>$ref->{partsgroup}</td>|;
- map { print "$column_data{$_}\n" } @column_index;
-
- print "
- </tr>
-";
- }
-
- print qq|
- </table>
- </td>
- </tr>
- <tr>
- <td><hr size=3 noshade></td>
- </tr>
-</table>
-
-<br>
-<form method=post action=$form->{script}>
-
-<input name=callback type=hidden value="$form->{callback}">
-
-<input type=hidden name=type value=$form->{type}>
-
-<input class=submit type=submit name=action value="|
- . $locale->text('Add') . qq|">
+ $::form->{callback} = $callback;
- </form>
+ $::form->header;
+ print $::form->parse_html_template('pe/partsgroup_report', {
+ option => $option,
+ callback => $callback,
+ editlink => build_std_url('action=edit', qw(type status callback)),
+ });
-</body>
-</html>
-|;
-
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
}
-sub form_partsgroup_header {
- $main::lxdebug->enter_sub();
-
- $main::auth->assert('config');
-
- my $form = $main::form;
- my $locale = $main::locale;
-
- $form->{title} = $locale->text("$form->{title} Group");
+sub form_partsgroup {
+ $::lxdebug->enter_sub;
+ $::auth->assert('config');
# $locale->text('Add Group')
# $locale->text('Edit Group')
+ $::form->{title} = $::locale->text("$::form->{title} Group");
- $form->{partsgroup} =~ s/\"/"/g;
-
- $form->header;
-
- print qq|
-<body>
-
-<form method=post action=$form->{script}>
-
-<input type=hidden name=id value=$form->{id}>
-<input type=hidden name=type value=$form->{type}>
-
-<table width=100%>
- <tr>
- <th class=listtop>$form->{title}</th>
- </tr>
- <tr height="5"></tr>
- <tr>
- <td>
- <table width=100%>
- <tr>
- <th align=right>| . $locale->text('Group') . qq|</th>
- <td><input name=partsgroup size=30 value="$form->{partsgroup}"></td>
- </tr>
- </table>
- </td>
- </tr>
- <tr>
- <td colspan=2><hr size=3 noshade></td>
- </tr>
-</table>
-|;
-
- $main::lxdebug->leave_sub();
-}
+ $::form->header;
+ print $::form->parse_html_template('pe/partsgroup_form');
-sub form_partsgroup_footer {
- $main::lxdebug->enter_sub();
-
- $main::auth->assert('config');
-
- my $form = $main::form;
- my $locale = $main::locale;
-
- print qq|
-
-<input name=callback type=hidden value="$form->{callback}">
-
-<br><input type=submit class=submit name=action value="|
- . $locale->text('Save') . qq|">
-|;
-
- if ($form->{id} && $form->{orphaned}) {
- print qq|
-<input type=submit class=submit name=action value="|
- . $locale->text('Delete') . qq|">|;
- }
-
-# button for saving history
-print qq|
- <input type=button onclick=set_history_window(|
- . $form->{id}
- . qq|); name=history id=history value=|
- . $locale->text('history')
- . qq|>|;
-# /button for saving history
- print qq|
-</form>
-
-</body>
-</html>
-|;
-
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
}
-#################################
-# get pricesgroups and build up html-code
-#
sub pricegroup_report {
- $main::lxdebug->enter_sub();
+ $::lxdebug->enter_sub;
+ $::auth->assert('config');
- $main::auth->assert('config');
+ $::form->{$_} = $::form->unescape($::form->{$_}) for qw(pricegroup);
+ PE->pricegroups(\%::myconfig, $::form);
- my $form = $main::form;
- my %myconfig = %main::myconfig;
- my $locale = $main::locale;
+ my $callback = build_std_url('action=pricegroup_report', qw(type status));
- map { $form->{$_} = $form->unescape($form->{$_}) } qw(pricegroup);
- PE->pricegroups(\%myconfig, \%$form);
+ my $option = '';
+ $option .= $::locale->text('All') if $::form->{status} eq 'all';
+ $option .= $::locale->text('Orphaned') if $::form->{status} eq 'orphaned';
- my $callback =
- "$form->{script}?action=pricegroup_report&type=$form->{type}&status=$form->{status}";
-
- my $option;
- if ($form->{status} eq 'all') {
- $option = $locale->text('All');
- }
- if ($form->{status} eq 'orphaned') {
- $option .= $locale->text('Orphaned');
+ if ($::form->{pricegroup}) {
+ $callback .= "&pricegroup=$::form->{pricegroup}";
+ $option .= ", " . $::locale->text('Pricegroup') . " : $::form->{pricegroup}";
}
- if ($form->{pricegroup}) {
- $callback .= "&pricegroup=$form->{pricegroup}";
- $option .=
- "\n<br>" . $locale->text('Pricegroup') . " : $form->{pricegroup}";
- }
-
- my @column_index = $form->sort_columns(qw(pricegroup));
- my %column_header;
- $column_header{pricegroup} =
- qq|<th class=listheading width=90%>|
- . $locale->text('Pricegroup')
- . qq|</th>|;
-
- $form->{title} = $locale->text('Pricegroup');
-
- $form->header;
-
- print qq|
-<body>
-
-<table width=100%>
- <tr>
- <th class=listtop>$form->{title}</th>
- </tr>
- <tr height="5"></tr>
- <tr>
- <td>$option</td>
- </tr>
- <tr>
- <td>
- <table width=100%>
- <tr class=listheading>
-|;
-
- map { print "$column_header{$_}\n" } @column_index;
-
- print qq|
- </tr>
-|;
# escape callback
- $form->{callback} = $callback;
-
- # escape callback for href
- $callback = $form->escape($callback);
-
- my ($i, %column_data);
- foreach my $ref (@{ $form->{item_list} }) {
-
- $i++;
- $i %= 2;
+ $::form->{callback} = $callback;
- print qq|
- <tr valign=top class=listrow$i>
-|;
- $column_data{pricegroup} =
- qq|<td><a href=$form->{script}?action=edit&type=$form->{type}&status=$form->{status}&id=$ref->{id}&callback=$callback>$ref->{pricegroup}</td>|;
+ $::form->header;
+ print $::form->parse_html_template('pe/pricegroup_report', {
+ option => $option,
+ callback => $callback,
+ editlink => build_std_url('action=edit', qw(type status callback)),
+ });
- map { print "$column_data{$_}\n" } @column_index;
-
- print "
- </tr>
-";
- }
-
- print qq|
- </table>
- </td>
- </tr>
- <tr>
- <td><hr size=3 noshade></td>
- </tr>
-</table>
-
-<br>
-<form method=post action=$form->{script}>
-
-<input name=callback type=hidden value="$form->{callback}">
-
-<input type=hidden name=type value=$form->{type}>
-
-<input class=submit type=submit name=action value="|
- . $locale->text('Add') . qq|">
-
- </form>
-
-</body>
-</html>
-|;
-
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
}
-#######################
-#build up pricegroup_header
-#
-sub form_pricegroup_header {
- $main::lxdebug->enter_sub();
-
- $main::auth->assert('config');
-
- my $form = $main::form;
- my $locale = $main::locale;
+sub form_pricegroup {
+ $::lxdebug->enter_sub;
+ $::auth->assert('config');
# $locale->text('Add Pricegroup')
# $locale->text('Edit Pricegroup')
+ $::form->{title} = $::locale->text("$::form->{title} Pricegroup");
- $form->{title} = $locale->text("$form->{title} Pricegroup");
-
- $form->{pricegroup} =~ s/\"/"/g;
-
- $form->header;
-
- print qq|
-<body>
-
-<form method=post action=$form->{script}>
-
-<input type=hidden name=id value=$form->{id}>
-<input type=hidden name=type value=$form->{type}>
-
-<table width=100%>
- <tr>
- <th class=listtop>$form->{title}</th>
- </tr>
- <tr height="5"></tr>
- <tr>
- <td>
- <table width=100%>
- <tr>
- <th align=right>| . $locale->text('Preisgruppe') . qq|</th>
- <td><input name=pricegroup size=30 value="$form->{pricegroup}"></td>
- </tr>
- </table>
- </td>
- </tr>
- <tr>
- <td colspan=2><hr size=3 noshade></td>
- </tr>
-</table>
-|;
-
- $main::lxdebug->leave_sub();
-}
-######################
-#build up pricegroup_footer
-#
-sub form_pricegroup_footer {
- $main::lxdebug->enter_sub();
-
- $main::auth->assert('config');
-
- my $form = $main::form;
- my $locale = $main::locale;
-
- print qq|
-
-<input name=callback type=hidden value="$form->{callback}">
-
-<br><input type=submit class=submit name=action value="|
- . $locale->text('Save') . qq|">
-|;
-
- if ($form->{id} && $form->{orphaned}) {
- print qq|
-<input type=submit class=submit name=action value="|
- . $locale->text('Delete') . qq|">|;
- }
+ $::form->header;
+ print $::form->parse_html_template('pe/pricegroup_form');
-# button for saving history
-print qq|
- <input type=button onclick=set_history_window(|
- . $form->{id}
- . qq|); name=history id=history value=|
- . $locale->text('history')
- . qq|>|;
-# /button for saving history
- print qq|
-</form>
-
-</body>
-</html>
-|;
-
- $main::lxdebug->leave_sub();
+ $::lxdebug->leave_sub;
}
map { $form->{selectdepartment} .= "<option>$_->{description}--$_->{id}\n" } @{ $form->{all_departments} || [] };
}
- my $department = qq|
+ my $department;
+ $department = qq|
<tr>
<th align=right nowrap>| . $locale->text('Department') . qq|</th>
<td colspan=3><select name=department>$form->{selectdepartment}</select></td>
my $form = $main::form;
my %params = @_;
- my $postfix = '_login' if ($params{login_screen});
+ my $postfix = $params{login_screen} ? '_login' : '';
my %todo_cfg = TODO->get_user_config('login' => $form->{login});
$::form->{title} = $::locale->text('Tax Office Preferences');
- my $select_tax_office = $ustva->fa_auswahl($land, $amt, $ustva->query_finanzamt(\%::myconfig, $::form));
- my $checked_accrual = q|checked="checked"| if ($::form->{method} eq 'accrual');
- my $checked_cash = q|checked="checked"| if ($::form->{method} eq 'cash');
- my $checked_monthly = "checked" if ($::form->{FA_voranmeld} eq 'month');
- my $checked_quarterly = "checked" if ($::form->{FA_voranmeld} eq 'quarter');
- my $checked_dauerfristverlaengerung = "checked" if ($::form->{FA_dauerfrist} eq '1');
- my $checked_kz_71 = "checked" if ($::form->{FA_71} eq 'X');
+ my $select_tax_office = $ustva->fa_auswahl($land, $amt, $ustva->query_finanzamt(\%::myconfig, $::form));
+ my $checked_accrual = $::form->{method} eq 'accrual' ? q|checked="checked"| : '';
+ my $checked_cash = $::form->{method} eq 'cash' ? q|checked="checked"| : '';
+ my $checked_monthly = $::form->{FA_voranmeld} eq 'month' ? "checked" : '';
+ my $checked_quarterly = $::form->{FA_voranmeld} eq 'quarter' ? "checked" : '';
+ my $checked_dauerfristverlaengerung = $::form->{FA_dauerfrist} eq '1' ? "checked" : '';
+ my $checked_kz_71 = $::form->{FA_71} eq 'X' ? "checked" : '';
my $_hidden_variables_ref;
my $patterncount = $form->{patterncount};
my $elster_pattern = $form->{elster_pattern};
my $delimiter = $form->{delimiter};
- my $steuernummer = $form->{steuernummer} if ($stnr eq '');
+ my $steuernummer = $stnr eq '' ? $form->{steuernummer} : '';
$form->{FA_Oeffnungszeiten} =~ s/\\\\n/\n/g;
# to the lx-office log will be put here if triggered from the console
log_file = /tmp/lxoffice_console_debug.log
+[testing]
+
+# autologin to use if none is given
+login = demo
+
[debug]
# Use DBIx::Log4perl for logging DBI calls. The string LXDEBUGFILE
# will be replaced by the file name configured for $::lxdebug.
--- /dev/null
+package Support::TestSetup;
+
+use strict;
+
+use Data::Dumper;
+use CGI qw( -no_xhtml);
+use SL::Auth;
+use SL::Form;
+use SL::Locale;
+use SL::LXDebug;
+use Data::Dumper;
+use SL::LxOfficeConf;
+use SL::InstanceConfiguration;
+SL::LxOfficeConf->read;
+
+sub _login {
+ my $login = shift;
+
+ die 'need login' unless $login;
+
+ package main;
+
+ $::lxdebug = LXDebug->new(file => \*STDERR);
+ $::locale = Locale->new($::lx_office_conf{system}->{language});
+ $::form = Form->new;
+ $::auth = SL::Auth->new;
+ $::instance_conf = SL::InstanceConfiguration->new;
+ $::request = { cgi => CGI->new({}) };
+
+ die 'cannot reach auth db' unless $::auth->session_tables_present;
+
+ $::auth->restore_session;
+
+ require "bin/mozilla/common.pl";
+
+ die "cannot find user $login" unless %::myconfig = $::auth->read_user($login);
+
+ $::form->{login} = $login; # normaly implicit at login
+
+ die "cannot find locale for user $login" unless $::locale = Locale->new($::myconfig{countrycode});
+
+ $::instance_conf->init;
+
+ return 1;
+}
+
+sub login {
+ my $login = shift || $::lx_office_conf{testing}{login} || 'demo';
+ _login($login);
+}
+
+1;
--- /dev/null
+use lib 't';
+
+use Test::More tests => 13;
+use Test::Deep;
+use Data::Dumper;
+
+use_ok 'Support::TestSetup';
+use_ok 'SL::Controller::Helper::ParseFilter';
+
+undef *::any; # Test::Deep exports any (for junctions) and MoreCommon exports any (like in List::Moreutils)
+
+Support::TestSetup::login();
+my ($filter, $expected);
+
+sub test ($$$) {
+ my $got = { parse_filter($_[0]) };
+ cmp_deeply(
+ $got,
+ $_[1],
+ $_[2]
+ ) or do {
+ print STDERR "expected => ", Dumper($_[1]), "\ngot: => ", Dumper($got), $/;
+ }
+}
+
+test { }, {
+}, 'minimal test';
+
+test {
+ name => 'Test',
+ whut => 'moof',
+}, {
+ query => [ %{{
+ name => 'Test',
+ whut => 'moof'
+ }} ],
+}, 'basic test';
+
+test {
+ customer => {
+ name => 'rainer',
+ }
+}, {
+ query => [ 'customer.name' => 'rainer' ],
+ with_objects => [ 'customer' ],
+}, 'joining customers';
+
+test {
+ customer => {
+ chart => {
+ accno => 'test',
+ }
+ }
+}, {
+ query => [ 'customer.chart.accno' => 'test' ],
+ with_objects => bag( 'customer', 'chart' ),
+}, 'nested joins';
+
+test {
+ 'customer:substr' => 'Meyer'
+}, {
+ query => [ customer => '%Meyer%' ]
+}, 'simple filter substr';
+
+test {
+ 'customer::ilike' => 'Meyer'
+}, {
+ query => [ customer => { ilike => 'Meyer' } ]
+}, 'simple method ilike';
+
+test {
+ customer => {
+ chart => {
+ 'accno:tail::like' => '1200'
+ }
+ },
+},
+{
+ query => [ 'customer.chart.accno' => { like => '%1200' } ],
+ with_objects => bag('customer', 'chart' ),
+}, 'all together';
+
+
+test {
+ customer => {
+ name => 'test',
+ },
+ invoice => {
+ customer => {
+ name => 'test',
+ },
+ },
+}, {
+ 'query' => [ %{{
+ 'invoice.customer.name' => 'test',
+ 'customer.name' => 'test',
+ }} ],
+ 'with_objects' => bag( 'invoice', 'customer' )
+}, 'object in more than one relationship';
+
+test {
+ 'orddate:date::' => 'lt',
+ 'orddate:date' => '20.3.2010',
+}, {
+ 'query' => [
+ 'orddate' => { 'lt' => isa('DateTime') }
+ ]
+
+}, 'method dispatch and date constructor';
+
+test {
+ id => [
+ 123, 125, 157
+ ]
+}, {
+ query => [ id => [ 123,125,157 ] ],
+}, 'arrays as value';
+
+test {
+ 'sellprice:number' => [
+ '123,4', '2,34', '0,4',
+ ]
+}, {
+ query => [
+ sellprice => [ 123.4, 2.34, 0.4 ],
+ ],
+}, 'arrays with filter';
+
--- /dev/null
+use strict;
+use lib 't';
+use Support::Files;
+use Test::More;
+
+if (eval { require PPI; 1 }) {
+ plan tests => scalar(@Support::Files::testitems);
+} else {
+ plan skip_all => "PPI not installed";
+}
+
+my $fh;
+{
+ local $^W = 0; # Don't complain about non-existent filehandles
+ if (-e \*Test::More::TESTOUT) {
+ $fh = \*Test::More::TESTOUT;
+ } elsif (-e \*Test::Builder::TESTOUT) {
+ $fh = \*Test::Builder::TESTOUT;
+ } else {
+ $fh = \*STDOUT;
+ }
+}
+
+my @testitems = @Support::Files::testitems;
+
+foreach my $file (@testitems) {
+ my $clean = 1;
+ my $source;
+ {
+ # due to a bug in PPI it cannot determine the encoding of a source file by
+ # use utf8; normaly this would be no problem but some people instist on
+ # putting strange stuff into the source. as a workaround read in the source
+ # with :utf8 layer and pass it to PPI by reference
+ # there are still some latin chars, but it's not the purpose of this test
+ # to find them, so warnings about it will be ignored
+ local $^W = 0; # don't care about invalid chars in comments
+ local $/ = undef;
+ open my $fh, '<:utf8', $file or die $!;
+ $source = <$fh>;
+ }
+
+ my $doc = PPI::Document->new(\$source) or do {
+ print $fh "?: PPI error for file $file: " . PPI::Document::errstr() . "\n";
+ ok 0, $file;
+ next;
+ };
+ my $stmts = $doc->find('Statement::Variable');
+
+ for my $var (@{ $stmts || [] }) {
+ # local can have valid uses like this, and our is extremely uncommon
+ next unless $var->type eq 'my';
+
+ # no if? alright
+ next unless $var->find(sub { $_[1]->content eq 'if' });
+
+ # token "if" is not in the top level struvture - no problem
+ # most likely an anonymous sub or a complicated map/grep/reduce
+ next unless grep { $_->content eq 'if' } $var->schildren;
+
+ $clean = 0;
+ print $fh "?: $var \n";
+ }
+
+ ok $clean, $file;
+}
--- /dev/null
+use strict;
+use Test::More;
+
+use lib 't';
+
+use_ok 'Support::TestSetup';
+use_ok 'SL::DB::Part';
+use_ok 'SL::DB::Warehouse';
+use_ok 'SL::WH';
+
+Support::TestSetup::login();
+
+my $part = SL::DB::Manager::Part->get_first;
+is(ref $part, 'SL::DB::Part', 'loading a part to test with id ' . $part->id);
+
+my $wh = SL::DB::Manager::Warehouse->get_first;
+is(ref $wh, 'SL::DB::Warehouse', 'loading a warehouse to test with id ' . $wh->id);
+
+my $bin1 = $wh->bins->[0];
+is(ref $bin1, 'SL::DB::Bin', 'getting first bin to test with id ' . $bin1->id);
+
+my $bin2 = $wh->bins->[1];
+is(ref $bin2, 'SL::DB::Bin', 'getting another bin to test with id ' . $bin2->id);
+
+my $report = sub {
+ $::form->{l_warehouseid} = 'Y';
+ $::form->{l_binid} = 'Y';
+ my ($result) = WH->get_warehouse_report(
+ warehouse_id => $wh->id,
+ bin_id => $bin1->id,
+ partsid => $part->id,
+ chargenumber => '',
+ );
+ $result->{qty} ||= 0;
+ return $result;
+};
+
+my $r1 = $report->();
+
+WH->transfer({
+ transfer_type => 'transfer',
+ parts_id => $part->id,
+ src_warehouse_id => $wh->id,
+ dst_warehouse_id => $wh->id,
+ src_bin_id => $bin1->id,
+ dst_bin_id => $bin2->id,
+ qty => 4,
+ chargenumber => '',
+});
+
+my $r2 = $report->();
+
+is $r1->{qty}, $r2->{qty} + 4, 'transfer one way';
+
+WH->transfer({
+ transfer_type => 'transfer',
+ parts_id => $part->id,
+ src_warehouse_id => $wh->id,
+ dst_warehouse_id => $wh->id,
+ src_bin_id => $bin2->id,
+ dst_bin_id => $bin1->id,
+ qty => 4,
+ chargenumber => '',
+});
+
+
+my $r3 = $report->();
+
+is $r2->{qty}, $r3->{qty} - 4, 'and back';
+
+done_testing;
+
+
+
+
+
+1;
--- /dev/null
+[%- USE L %]
+[%- USE T8 %]
+[%- USE HTML %]
+[% L.javascript_tag('show_history.js') %]
+<body>
+
+<form method=post action="[% script %]">
+
+<input type=hidden name=id value="[% id %]">
+<input type=hidden name=type value="[% type %]">
+
+<table width=100%>
+ <tr>
+ <th class=listtop>[% title %]</th>
+ </tr>
+ <tr height="5"></tr>
+ <tr>
+ <td>
+ <table width=100%>
+ <tr>
+ <th align=right>[% 'Group' | $T8 %]</th>
+ <td><input name=partsgroup size=30 value="[% partsgroup | html %]"></td>
+ </tr>
+ </table>
+ </td>
+ </tr>
+ <tr>
+ <td colspan=2><hr size=3 noshade></td>
+ </tr>
+</table>
+
+<br>
+
+<input name=callback type=hidden value="[% callback | html %]">
+<input type=submit class=submit name=action value="[% 'Save' | $T8 %]">
+[%- IF id && orphaned %]
+<input type=submit class=submit name=action value="[% 'Delete' | $T8 %]">
+[%- END %]
+
+<input type=button onclick="set_history_window([% id %]);" name=history id=history value="[% 'history' | $T8 %]">
+</form>
+
+</body>
+</html>
--- /dev/null
+[%- USE HTML %]
+[%- USE T8 %]
+<body>
+
+<table width=100%>
+ <tr>
+ <th class=listtop>[% 'Groups' | $T8 %]</th>
+ </tr>
+ <tr height="5"></tr>
+ <tr>
+ <td>[% option %]</td>
+ </tr>
+ <tr>
+ <td>
+ <table width=100%>
+ <tr class=listheading>
+ <th class=listheading width=90%>[% 'Group' | $T8 %]</th>
+ </tr>
+[%- FOREACH row = item_list %]
+ <tr valign=top class="listrow[% loop.count % 2 %]">
+ <td><a href="[% editlink %]&id=[% row.id %]">[% row.partsgroup %]</a></td>
+ </tr>
+[%- END %]
+ </table>
+ </td>
+ </tr>
+ <tr>
+ <td><hr size=3 noshade></td>
+ </tr>
+</table>
+
+<br>
+<form method=post action="[% script %]">
+ <input name=callback type=hidden value="[% callback | html %]">
+ <input type=hidden name=type value="[% type %]">
+ <input class=submit type=submit name=action value="[% 'Add' | $T8 %]">
+</form>
+
+</body>
+</html>
+
--- /dev/null
+[%- USE L %]
+[%- USE T8 %]
+[%- USE HTML %]
+[% L.javascript_tag('show_history.js') %]
+<body>
+
+<form method=post action="[% script %]">
+
+<input type=hidden name=id value="[% id %]"
+<input type=hidden name=type value="[% type %]">
+
+<table width=100%>
+ <tr>
+ <th class=listtop>[% title %]</th>
+ </tr>
+ <tr height="5"></tr>
+ <tr>
+ <td>
+ <table width=100%>
+ <tr>
+ <th align=right>[% 'Pricegroup' | $T8 %]</th>
+ <td><input name=pricegroup size=30 value="[% pricegroup | html %]"></td>
+ </tr>
+ </table>
+ </td>
+ </tr>
+ <tr>
+ <td colspan=2><hr size=3 noshade></td>
+ </tr>
+</table>
+
+<br>
+
+<input name=callback type=hidden value="[% callback | html %]">
+<input type=submit class=submit name=action value="[% 'Save' | $T8 %]">
+[%- IF id && orphaned %]
+<input type=submit class=submit name=action value="[% 'Delete' | $T8 %]">
+[%- END %]
+
+<input type=button onclick="set_history_window([% id %]);" name=history id=history value="[% 'history' | $T8 %]">
+</form>
+
+</body>
+</html>
--- /dev/null
+[%- USE HTML %]
+[%- USE T8 %]
+<body>
+
+<table width=100%>
+ <tr>
+ <th class=listtop>[% 'Pricegroup' | $T8 %]</th>
+ </tr>
+ <tr height="5"></tr>
+ <tr>
+ <td>[% option %]</td>
+ </tr>
+ <tr>
+ <td>
+ <table width=100%>
+ <tr class=listheading>
+ <th class=listheading width=90%>[% 'Pricegroup' | $T8 %]</th>
+ </tr>
+[%- FOREACH row = item_list %]
+ <tr valign=top class="listrow[% loop.count % 2 %]">
+ <td><a href="[% editlink %]&id=[% row.id %]">[% row.pricegroup %]</a></td>
+ </tr>
+[%- END %]
+ </table>
+ </td>
+ </tr>
+ <tr>
+ <td><hr size=3 noshade></td>
+ </tr>
+</table>
+
+<br>
+<form method=post action="[% script %]">
+ <input name=callback type=hidden value="[% callback | html %]">
+ <input type=hidden name=type value="[% type %]">
+ <input class=submit type=submit name=action value="[% 'Add' | $T8 %]">
+</form>
+
+</body>
+</html>
+
--- /dev/null
+[%- USE T8 %]
+[%- USE LxERP %]
+<body>
+
+<form method=post action="[% script %]">
+
+<input type=hidden name=sort value="[% is_pricegroup ? 'pricegroup' : 'partsgroup' %]">
+<input type=hidden name=type value="[% type %]">
+
+<table width=100%>
+ <tr>
+ <th class=listtop>[% is_pricegroup ? LxERP.t8('Pricegroup') : LxERP.t8('Groups') %]</th>
+ </tr>
+ <tr height="5"></tr>
+ <tr>
+ <td>
+ <table width=100%>
+ <tr>
+[%- IF is_pricegroup %]
+ <th align=right width=1%>[% 'Pricegroup' | $T8 %]</th>
+ <td><input name=pricegroup size=20></td>
+[%- ELSE %]
+ <th align=right width=1%>[% 'Group' | $T8 %]</th>
+ <td><input name=partsgroup size=20></td>
+[%- END %]
+ </tr>
+ <tr>
+ <td></td>
+ <td><input name=status class=radio type=radio value=all checked> [% 'All' | $T8 %]
+ <input name=status class=radio type=radio value=orphaned> [% 'Orphaned' | $T8 %]</td>
+ </tr>
+ </table>
+ </td>
+ </tr>
+ <tr>
+ <td><hr size=3 noshade></td>
+ </tr>
+</table>
+
+<input type=hidden name=nextsub value="[% is_pricegroup ? 'pricegroup_report' : 'partsgroup_report' %]">
+
+<br>
+<input class=submit type=submit name=action value="[% 'Continue' | $T8 %]">
+</form>
+
+</body>
+</html>
+
projects / mfinanz.git / commitdiff