kivitendo/bin/mozilla/bp.pl @ 5bc72844
| d319704a | Moritz Bunkus | #=====================================================================
|
||
# LX-Office ERP
|
||||
# Copyright (C) 2004
|
||||
# Based on SQL-Ledger Version 2.1.9
|
||||
# Web http://www.lx-office.org
|
||||
#
|
||||
#=====================================================================
|
||||
# SQL-Ledger Accounting
|
||||
# Copyright (c) 2003
|
||||
#
|
||||
# Author: Dieter Simader
|
||||
# Email: dsimader@sql-ledger.org
|
||||
# Web: http://www.sql-ledger.org
|
||||
#
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
#======================================================================
|
||||
#
|
||||
# Batch printing
|
||||
#
|
||||
#======================================================================
|
||||
use SL::BP;
|
||||
| 1b3fe156 | Sven Schöling | use Data::Dumper;
|
||
| e74c2ab4 | Sven Schöling | use List::Util qw(first);
|
||
| d319704a | Moritz Bunkus | |||
1;
|
||||
| 40782548 | Moritz Bunkus | require "bin/mozilla/common.pl";
|
||
| 3314d7c2 | Sven Schöling | use strict;
|
||
| d319704a | Moritz Bunkus | # end of main
|
||
| 8c7e4493 | Moritz Bunkus | sub assert_bp_access {
|
||
| 3314d7c2 | Sven Schöling | my $form = $main::form;
|
||
| 8c7e4493 | Moritz Bunkus | my %access_map = (
|
||
'invoice' => 'invoice_edit',
|
||||
'sales_order' => 'sales_order_edit',
|
||||
'sales_quotation' => 'sales_quotation_edit',
|
||||
'purchase_order' => 'purchase_order_edit',
|
||||
'request_quotation' => 'request_quotation_edit',
|
||||
'check' => 'cash',
|
||||
'receipt' => 'cash',
|
||||
);
|
||||
if ($form->{type} && $access_map{$form->{type}}) {
|
||||
| 3314d7c2 | Sven Schöling | $main::auth->assert($access_map{$form->{type}});
|
||
| 8c7e4493 | Moritz Bunkus | |||
} else {
|
||||
| 3314d7c2 | Sven Schöling | $main::auth->assert('DOES_NOT_EXIST');
|
||
| 8c7e4493 | Moritz Bunkus | }
|
||
}
|
||||
| d319704a | Moritz Bunkus | sub search {
|
||
| e6f43104 | Sven Schöling | $::lxdebug->enter_sub;
|
||
| d319704a | Moritz Bunkus | |||
| 8c7e4493 | Moritz Bunkus | assert_bp_access();
|
||
| d319704a | Moritz Bunkus | # setup customer/vendor selection
|
||
| e6f43104 | Sven Schöling | BP->get_vc(\%::myconfig, $::form);
|
||
| d319704a | Moritz Bunkus | |||
| 3314d7c2 | Sven Schöling | my %label = (
|
||
| e6f43104 | Sven Schöling | invoice => { title => $::locale->text('Sales Invoices'), invnumber => 1, ordnumber => 1 },
|
||
sales_order => { title => $::locale->text('Sales Orders'), ordnumber => 1, },
|
||||
purchase_order => { title => $::locale->text('Purchase Orders'), ordnumber => 1, },
|
||||
sales_quotation => { title => $::locale->text('Quotations'), quonumber => 1, },
|
||||
request_quotation => { title => $::locale->text('RFQs'), quonumber => 1, },
|
||||
check => { title => $::locale->text('Checks'), chknumber => 1, },
|
||||
receipt => { title => $::locale->text('Receipts'), rctnumber => 1, },
|
||||
);
|
||||
| d319704a | Moritz Bunkus | |||
| e6f43104 | Sven Schöling | my $bp_accounts = $::form->{type} =~ /check|receipt/
|
||
&& BP->payment_accounts(\%::myconfig, $::form);
|
||||
| d319704a | Moritz Bunkus | |||
| e6f43104 | Sven Schöling | $::form->header;
|
||
print $::form->parse_html_template('bp/search', {
|
||||
label => \%label,
|
||||
show_accounts => $bp_accounts,
|
||||
account_sub => sub { ("$_[0]{accno}--$_[0]{description}")x2 },
|
||||
vc_keys => sub { "$_[0]{name}--$_[0]{id}" },
|
||||
});
|
||||
| d319704a | Moritz Bunkus | |||
| e6f43104 | Sven Schöling | $::lxdebug->leave_sub;
|
||
| d319704a | Moritz Bunkus | }
|
||
sub remove {
|
||||
| 3314d7c2 | Sven Schöling | $main::lxdebug->enter_sub();
|
||
my $form = $main::form;
|
||||
my $locale = $main::locale;
|
||||
| d319704a | Moritz Bunkus | |||
| 8c7e4493 | Moritz Bunkus | assert_bp_access();
|
||
| 3314d7c2 | Sven Schöling | my $selected = 0;
|
||
| d319704a | Moritz Bunkus | |||
| 3314d7c2 | Sven Schöling | for my $i (1 .. $form->{rowcount}) {
|
||
| d319704a | Moritz Bunkus | if ($form->{"checked_$i"}) {
|
||
$selected = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
$form->error('Nothing selected!') unless $selected;
|
||||
$form->{title} = $locale->text('Confirm!');
|
||||
$form->header;
|
||||
print qq|
|
||||
<body>
|
||||
| 8c7e4493 | Moritz Bunkus | <form method=post action=bp.pl>
|
||
| d319704a | Moritz Bunkus | |;
|
||
map { delete $form->{$_} } qw(action header);
|
||||
| 3314d7c2 | Sven Schöling | foreach my $key (keys %$form) {
|
||
| 8c7e4493 | Moritz Bunkus | next if (($key eq 'login') || ($key eq 'password') || ('' ne ref $form->{$key}));
|
||
| d319704a | Moritz Bunkus | print qq|<input type=hidden name=$key value="$form->{$key}">\n|;
|
||
}
|
||||
print qq|
|
||||
<h2 class=confirm>$form->{title}</h2>
|
||||
<h4>|
|
||||
| 081a4f97 | Moritz Bunkus | . $locale->text(
|
||
'Are you sure you want to remove the marked entries from the queue?')
|
||||
| d319704a | Moritz Bunkus | . qq|</h4>
|
||
<input name=action class=submit type=submit value="|
|
||||
. $locale->text('Yes') . qq|">
|
||||
</form>
|
||||
</body>
|
||||
</html>
|
||||
|;
|
||||
| 3314d7c2 | Sven Schöling | $main::lxdebug->leave_sub();
|
||
| d319704a | Moritz Bunkus | }
|
||
sub yes {
|
||||
| 3314d7c2 | Sven Schöling | $main::lxdebug->enter_sub();
|
||
my $form = $main::form;
|
||||
my %myconfig = %main::myconfig;
|
||||
my $locale = $main::locale;
|
||||
| d319704a | Moritz Bunkus | |||
| 8c7e4493 | Moritz Bunkus | assert_bp_access();
|
||
| d319704a | Moritz Bunkus | $form->info($locale->text('Removing marked entries from queue ...'));
|
||
$form->{callback} .= "&header=1" if $form->{callback};
|
||||
$form->redirect($locale->text('Removed spoolfiles!'))
|
||||
| 8cd05ad6 | Moritz Bunkus | if (BP->delete_spool(\%myconfig, \%$form));
|
||
| d319704a | Moritz Bunkus | $form->error($locale->text('Cannot remove files!'));
|
||
| 3314d7c2 | Sven Schöling | $main::lxdebug->leave_sub();
|
||
| d319704a | Moritz Bunkus | }
|
||
sub print {
|
||||
| 3314d7c2 | Sven Schöling | $main::lxdebug->enter_sub();
|
||
my $form = $main::form;
|
||||
my %myconfig = %main::myconfig;
|
||||
my $locale = $main::locale;
|
||||
| d319704a | Moritz Bunkus | |||
| 8c7e4493 | Moritz Bunkus | assert_bp_access();
|
||
| 1b3fe156 | Sven Schöling | $form->get_lists(printers => 'ALL_PRINTERS');
|
||
# use the command stored in the databse or fall back to $myconfig{printer}
|
||||
| e74c2ab4 | Sven Schöling | my $selected_printer = first { $_ } map ({ $_ ->{printer_command} }
|
||
grep { $_->{id} eq $form->{printer} }
|
||||
@{ $form->{ALL_PRINTERS} }),
|
||||
$myconfig{printer};
|
||||
| 1b3fe156 | Sven Schöling | |||
| d319704a | Moritz Bunkus | if ($form->{callback}) {
|
||
map { $form->{callback} .= "&checked_$_=1" if $form->{"checked_$_"} }
|
||||
(1 .. $form->{rowcount});
|
||||
$form->{callback} .= "&header=1";
|
||||
}
|
||||
| 3314d7c2 | Sven Schöling | for my $i (1 .. $form->{rowcount}) {
|
||
| d319704a | Moritz Bunkus | if ($form->{"checked_$i"}) {
|
||
$form->info($locale->text('Printing ... '));
|
||||
| 8cd05ad6 | Moritz Bunkus | if (BP->print_spool(\%myconfig, \%$form, "| $selected_printer")) {
|
||
| d319704a | Moritz Bunkus | print $locale->text('done');
|
||
$form->redirect($locale->text('Marked entries printed!'));
|
||||
}
|
||||
| b2945bf6 | Sven Schöling | ::end_of_request();
|
||
| d319704a | Moritz Bunkus | }
|
||
}
|
||||
$form->error('Nothing selected!');
|
||||
| 3314d7c2 | Sven Schöling | $main::lxdebug->leave_sub();
|
||
| d319704a | Moritz Bunkus | }
|
||
sub list_spool {
|
||||
| 5bc72844 | Sven Schöling | $::lxdebug->enter_sub;
|
||
| 8c7e4493 | Moritz Bunkus | assert_bp_access();
|
||
| 5bc72844 | Sven Schöling | # parse old vc picker
|
||
$::form->{ $::form->{vc} } = $::form->unescape($::form->{ $::form->{vc} });
|
||||
($::form->{ $::form->{vc} }, $::form->{"$::form->{vc}_id"}) = split(/--/, $::form->{ $::form->{vc} });
|
||||
| d319704a | Moritz Bunkus | |||
| 5bc72844 | Sven Schöling | BP->get_spoolfiles(\%::myconfig, $::form);
|
||
| d319704a | Moritz Bunkus | |||
| 5bc72844 | Sven Schöling | my @href_options = ('vc', 'type', 'title', $::form->{vc});
|
||
| d319704a | Moritz Bunkus | |||
| 5bc72844 | Sven Schöling | my %option_texts = (
|
||
customer => sub { $::locale->text('Customer') . " : $::form->{customer}" },
|
||||
vendor => sub { $::locale->text('Customer') . " : $::form->{vendor}" },
|
||||
account => sub { $::locale->text('Account') . " : $::form->{account}" },
|
||||
invnumber => sub { $::locale->text('Invoice Number') . " : $::form->{invnumber}" },
|
||||
ordnumber => sub { $::locale->text('Order Number') . " : $::form->{ordnumber}" },
|
||||
quonumber => sub { $::locale->text('Quotation Number') . " : $::form->{quonumber}" },
|
||||
transdatefrom => sub { $::locale->text('From') . " " . $::locale->date(\%::myconfig, $::form->{transdatefrom}, 1) },
|
||||
transdateto => sub { $::locale->text('To') . " " . $::locale->date(\%::myconfig, $::form->{transdateto}, 1) },
|
||||
);
|
||||
| d319704a | Moritz Bunkus | |||
| 5bc72844 | Sven Schöling | my @options;
|
||
for my $key ($::form->{vc}, qw(account invnumber ordnumber quonumber transdatefrom transdateto)) {
|
||||
next unless $::form->{$key};
|
||||
push @href_options, $key;
|
||||
push @options, $option_texts{$key} ? $option_texts{$key}->() : '';
|
||||
| d319704a | Moritz Bunkus | }
|
||
| 5bc72844 | Sven Schöling | my $last_spoolfile;
|
||
for my $ref (@{ $::form->{SPOOL} }) {
|
||||
$ref->{module} = ($ref->{module} eq 'ar') ? "is" : "ir" if $ref->{invoice};
|
||||
$ref->{new_file} = $last_spoolfile ne $ref->{spoolfile};
|
||||
} continue {
|
||||
$last_spoolfile = $ref->{spoolfile};
|
||||
| d319704a | Moritz Bunkus | }
|
||
| 5bc72844 | Sven Schöling | $::form->get_lists(printers => "ALL_PRINTERS");
|
||
| d319704a | Moritz Bunkus | |||
| 5bc72844 | Sven Schöling | $::form->header;
|
||
print $::form->parse_html_template('bp/list_spool', {
|
||||
spool => $::lx_office_conf{paths}->{spool},
|
||||
href => build_std_url('bp.pl', @href_options),
|
||||
is_invoice => scalar ($::form->{type} =~ /^invoice$/),
|
||||
is_order => scalar ($::form->{type} =~ /_order$/),
|
||||
is_quotation => scalar ($::form->{type} =~ /_quotation$/),
|
||||
options => \@options,
|
||||
});
|
||||
| d319704a | Moritz Bunkus | |||
| 5bc72844 | Sven Schöling | $::lxdebug->leave_sub;
|
||
| d319704a | Moritz Bunkus | }
|
||
sub select_all {
|
||||
| 3314d7c2 | Sven Schöling | $main::lxdebug->enter_sub();
|
||
my $form = $main::form;
|
||||
| d319704a | Moritz Bunkus | |||
| 8c7e4493 | Moritz Bunkus | assert_bp_access();
|
||
| d319704a | Moritz Bunkus | map { $form->{"checked_$_"} = 1 } (1 .. $form->{rowcount});
|
||
&list_spool;
|
||||
| 3314d7c2 | Sven Schöling | $main::lxdebug->leave_sub();
|
||
| d319704a | Moritz Bunkus | }
|
||
| 3314d7c2 | Sven Schöling | sub continue { call_sub($main::form->{"nextsub"}); }
|