[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb:[3836] trunk
- Subject: SF.net SVN: ledger-smb:[3836] trunk
- From: ..hidden..
- Date: Tue, 11 Oct 2011 23:36:59 +0000
Revision: 3836
http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=3836&view=rev
Author: einhverfr
Date: 2011-10-11 23:36:58 +0000 (Tue, 11 Oct 2011)
Log Message:
-----------
Trunk is now broken anyway and I have to commit before I can fix this refactoring. However, this moves the scripts/ files into LedgerSMB/Scripts/ for easier management.
Modified Paths:
--------------
trunk/CONTRIBUTORS
trunk/LedgerSMB/JC.pm
trunk/UI/payments/payments_detail.html
trunk/doc/release_notes
trunk/lsmb-request.pl
Added Paths:
-----------
trunk/LedgerSMB/Scripts/
trunk/LedgerSMB/Scripts/account.pl
trunk/LedgerSMB/Scripts/admin.pl
trunk/LedgerSMB/Scripts/asset.pl
trunk/LedgerSMB/Scripts/custom/
trunk/LedgerSMB/Scripts/customer.pl
trunk/LedgerSMB/Scripts/drafts.pl
trunk/LedgerSMB/Scripts/employee.pl
trunk/LedgerSMB/Scripts/file.pl
trunk/LedgerSMB/Scripts/inventory.pl
trunk/LedgerSMB/Scripts/journal.pl
trunk/LedgerSMB/Scripts/login.pl
trunk/LedgerSMB/Scripts/menu.pl
trunk/LedgerSMB/Scripts/payment.pl
trunk/LedgerSMB/Scripts/recon.pl
trunk/LedgerSMB/Scripts/setup.pl
trunk/LedgerSMB/Scripts/taxform.pl
trunk/LedgerSMB/Scripts/user.pl
trunk/LedgerSMB/Scripts/vendor.pl
trunk/LedgerSMB/Scripts/vouchers.pl
Removed Paths:
-------------
trunk/doc/README
trunk/scripts/account.pl
trunk/scripts/admin.pl
trunk/scripts/asset.pl
trunk/scripts/custom/
trunk/scripts/customer.pl
trunk/scripts/drafts.pl
trunk/scripts/employee.pl
trunk/scripts/file.pl
trunk/scripts/inventory.pl
trunk/scripts/journal.pl
trunk/scripts/login.pl
trunk/scripts/menu.pl
trunk/scripts/payment.pl
trunk/scripts/recon.pl
trunk/scripts/setup.pl
trunk/scripts/taxform.pl
trunk/scripts/user.pl
trunk/scripts/vendor.pl
trunk/scripts/vouchers.pl
Property Changed:
----------------
trunk/
Property changes on: trunk
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/1.3:3711-3822
+ /branches/1.3:3711-3827
Modified: trunk/CONTRIBUTORS
===================================================================
--- trunk/CONTRIBUTORS 2011-10-11 22:53:56 UTC (rev 3835)
+++ trunk/CONTRIBUTORS 2011-10-11 23:36:58 UTC (rev 3836)
@@ -89,9 +89,18 @@
Herman Vierendeels <herman.vierendeels @ gmail.com> Contributed a number of
bugfixes.
-John Locke <john @ freelock.com> Contributed a number of bug fixes and provided
-extensive feedback and assistance.
+John Locke (Freelock Consulting) <john @ freelock.com> Contributed a number of
+bug fixes and provided extensive feedback and assistance.
+Lacey Powers (Command Prompt) has contributed code, and helped reduce the number
+of warnings coming from the inherited codebase.
+
+Alexey Klyukin (Command Prompt) has contributed code particularly to end of
+year routines, and helped address scalability issues.
+
+Andrew Sullivan (formerly with Command Prompt) has addressed scalability in the
+batch payment system.
+
Original Authors of SQL-Ledger:
===================================
Dieter Simader <dsimader @ sql-ledger.com>
Modified: trunk/LedgerSMB/JC.pm
===================================================================
--- trunk/LedgerSMB/JC.pm 2011-10-11 22:53:56 UTC (rev 3835)
+++ trunk/LedgerSMB/JC.pm 2011-10-11 23:36:58 UTC (rev 3836)
@@ -596,7 +596,7 @@
serialnumber = ?,
checkedin = ?::timestamp,
checkedout = ?::timestamp,
- employee_id = ?,
+ person_id = ?,
notes = ?
WHERE id = ?|;
$sth = $dbh->prepare($query);
Copied: trunk/LedgerSMB/Scripts/account.pl (from rev 3835, trunk/scripts/account.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/account.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/account.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,228 @@
+use Template;
+use LedgerSMB::DBObject::Account;
+package LedgerSMB::Scripts::account;
+use LedgerSMB::Log;
+use Data::Dumper;
+use strict;
+
+=pod
+
+=head1 NAME
+
+LedgerSMB:Scripts::account, LedgerSMB workflow scripts for managing accounts
+
+=head1 SYNOPSIS
+
+This module contains the workflows for managing chart of accounts entries.
+
+In prior versions of LedgerSMB, these were found in the AM.pm. In the current
+version, these have been broken out and given their own API which is more
+maintainable.
+
+=head1 METHODS
+
+=over
+
+=cut
+
+
+my $logger = Log::Log4perl::get_logger("LedgerSMB::DBObject::Account");
+
+=item new
+
+Displays a screen to create a new account.
+
+=cut
+
+sub new {
+ my ($request) = @_;
+ $request->{title} = $request->{_locale}->text('Add Account');
+ $request->{charttype} = 'A';
+ _display_account_screen($request);
+}
+
+=edit
+
+Retrieves account information and then displays the screen.
+
+Requires the id and charttype variables in the request to be set.
+
+=cut
+
+sub edit {
+ my ($request) = @_;
+ if (!defined $request->{id}){
+ $request->error('No ID provided');
+ } elsif (!defined $request->{charttype}){
+ $request->error('No Chart Type Provided');
+ }
+ $request->{chart_id} = $request->{id};
+ my $account = LedgerSMB::DBObject::Account->new(base => $request);
+ my @accounts = $account->get();
+ my $acc = shift @accounts;
+ if (!$acc){ # This should never happen. Any occurance of this is a bug.
+ $request->error($request->{_locale}->text('Bug: No such account'));
+ }
+ $acc->{title} = $request->{_locale}->text('Edit Account');
+ $acc->{_locale} = $request->{_locale};
+ _display_account_screen($acc);
+}
+
+=item save
+
+Saves the account.
+
+Request variables
+id: (optional): If set, overwrite existing account.
+accno: the text used to specify the account number
+description: Text to describe the account
+category: A = asset, L = liability, Q = Equity, I = Income, E = expense
+gifi_accno: The GIFI account entry control code
+heading: (Optional) The integer representing the heading.id desired
+contra: If true, the account balances on the opposite side.
+tax: If true, is a tax account
+link: a list of strings representing text box identifier.
+
+=cut
+
+sub save {
+ my ($request) = @_;
+ my $account = LedgerSMB::DBObject::Account->new(base => $request);
+ $account->{$account->{summary}}=$account->{summary};
+ if ($account->{charttype} eq 'A'){
+ delete $account->{heading};
+ }
+ $account->save;
+ edit($account);
+}
+
+=item save_as_new
+
+Saves as a new account. Deletes the id field and then calls save()
+
+=cut
+
+sub save_as_new {
+ my ($request) = @_;
+ $request->{id} = undef;
+ save($request);
+}
+
+# copied from AM.pm. To be refactored.
+sub _display_account_screen {
+ my ($form) = @_;
+ my $account = LedgerSMB::DBObject::Account->new({base => $form});
+ @{$form->{all_headings}} = $account->list_headings();
+ my $locale = $form->{_locale};
+ my $buttons = [];
+ my $checked;
+ my $hiddens;
+ my $logger = Log::Log4perl->get_logger('');
+ $logger->debug("scripts/account.pl Locale: $locale");
+
+ foreach my $item ( split( /:/, $form->{link} ) ) {
+ $form->{$item} = 1;
+ }
+
+ $hiddens->{type} = 'account';
+ $hiddens->{$_} = $form->{$_} foreach qw(id inventory_accno_id income_accno_id expense_accno_id fxgain_accno_id fxloss_accno_id);
+ $checked->{ $form->{charttype} } = "checked";
+
+ my %button = ();
+
+ if ( $form->{id} ) {
+ $button{'save'} =
+ { ndx => 3, key => 'S', value => $locale->text('Save') };
+ $button{'save_as_new'} =
+ { ndx => 7, key => 'N', value => $locale->text('Save as new') };
+
+ if ( $form->{orphaned} ) {
+ $button{'delete'} =
+ { ndx => 16, key => 'D', value => $locale->text('Delete') };
+ }
+ }
+ else {
+ $button{'save'} =
+ { ndx => 3, key => 'S', value => $locale->text('Save') };
+ }
+
+ for ( sort { $button{$a}->{ndx} <=> $button{$b}->{ndx} } keys %button ) {
+ push @{$buttons}, {
+ name => 'action',
+ value => $_,
+ accesskey => $button{$_}{key},
+ title => "$button{$_}{value} [Alt-$button{$_}{key}]",
+ text => $button{$_}{value},
+ };
+ }
+ my $template = LedgerSMB::Template->new_UI(
+ user => $form->{_user},
+ locale => $locale,
+ template => 'accounts/edit');
+ $template->render({
+ form => $form,
+ checked => $checked,
+ buttons => $buttons,
+ hiddens => $hiddens,
+ });
+
+}
+
+=item yearend_info
+
+Shows the yearend screen. No expected inputs.
+
+=cut
+
+sub yearend_info {
+ use LedgerSMB::DBObject::EOY;
+ my ($request) = @_;
+ my $eoy = LedgerSMB::DBObject::EOY->new(base => $request);
+ $eoy->list_earnings_accounts;
+ $eoy->{user} = $request->{_user};
+ my $template = LedgerSMB::Template->new_UI(
+ user => $request->{_user},
+ locale => $request->{_locale},
+ template => 'accounts/yearend'
+ );
+ $template->render($eoy);
+}
+
+=item post_yearend
+
+Posts a year-end closing transaction.
+
+Request variables expected:
+end_date: Date for the yearend transaction.
+reference: GL Source identifier.
+description: Description of transaction
+in_retention_acc_id: Account id to post retained earnings into
+
+=cut
+
+sub post_yearend {
+ use LedgerSMB::DBObject::EOY;
+ my ($request) = @_;
+ my $eoy = LedgerSMB::DBObject::EOY->new(base => $request);
+ $eoy->close_books;
+ my $template = LedgerSMB::Template->new_UI(
+ user => $request->{_user},
+ locale => $request->{_locale},
+ template => 'accounts/yearend_complete'
+ );
+ $template->render($eoy);
+
+}
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 LedgerSMB Core Team. This file is licensed under the GNU
+General Public License version 2, or at your option any later version. Please
+see the included License.txt for details.
+
+=cut
+
+
+1;
Copied: trunk/LedgerSMB/Scripts/admin.pl (from rev 3835, trunk/scripts/admin.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/admin.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/admin.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,448 @@
+#!/usr/bin/perl
+package LedgerSMB::Scripts::admin;
+use strict;
+
+=pod
+
+=head1 NAME
+
+LedgerSMB:Scripts::admin
+
+=head1 SYNOPSIS
+
+This module provides the workflow scripts for managing users and permissions.
+
+=head1 METHODS
+
+=over
+
+=cut
+
+require 'lsmb-request.pl';
+
+use LedgerSMB::Template;
+use LedgerSMB::DBObject::Admin;
+use LedgerSMB::DBObject::User;
+use Data::Dumper;
+use LedgerSMB::Setting;
+use LedgerSMB::Log;
+
+# I don't really like the code in this module. The callbacks are per form which
+# means there is no semantic difference between different buttons that can be
+# clicked. This results in a lot of code with a lot of conditionals which is
+# both difficult to read and maintain. In the future, this should be revisited
+# and rewritten. It makes the module too closely tied to the HTML. --CT
+
+my $logger = Log::Log4perl->get_logger('LedgerSMB::Scripts::admin');
+
+
+sub __edit_page {
+
+
+ my ($request, $otd) = @_;
+ # otd stands for Other Template Data.
+ my $dcsetting = LedgerSMB::Setting->new(base=>$request, copy=>'base');
+ my $default_country = $dcsetting->get('default_country');
+ my $admin = LedgerSMB::DBObject::Admin->new(base=>$request, copy=>'list', merge =>['user_id']);
+ my @all_roles = $admin->get_roles($request->{company});
+ my $user_obj = LedgerSMB::DBObject::User->new(base=>$request, copy=>'list', merge=>['user_id','company']);
+ $user_obj->{company} = $request->{company};
+ $user_obj->get($request->{user_id});
+ my $user = $request->{_user};
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ template => 'Admin/edit_user',
+ language => $user->{language},
+ format => 'HTML',
+ path=>'UI'
+ );
+ my $template_data =
+ {
+ user=>$user_obj,
+ roles=>@all_roles,
+ countries=>$admin->get_countries(),
+ user_roles=>$user_obj->{roles},
+ salutations=>$admin->get_salutations(),
+ default_country => $dcsetting->{value},
+ admin => $admin,
+ stylesheet => $request->{stylesheet},
+ };
+
+ for my $key (keys(%{$otd})) {
+
+ $template_data->{$key} = $otd->{$key};
+ }
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ template => 'Admin/edit_user',
+ language => $user->{language},
+ format => 'HTML',
+ path=>'UI'
+ );
+ $template->render($template_data);
+}
+
+=item save_user
+
+Saves the user information, including name, etc.
+
+This is also used to effect an administrative password reset or create new
+users. However, if the import value is set to 1, it will not set the password.
+
+The reasoning here is that we don't really want to set passwords when we are
+importing db cluster users into LedgerSMB. If that needs to be done it can be
+a separate stage.
+
+=cut
+
+sub save_user {
+ my ($request, $admin) = @_;
+ if ($request->{import} == "1"){
+ delete $request->{password};
+ }
+ my $admin = LedgerSMB::DBObject::Admin->new(base=>$request, copy=>'all');
+
+ my $sal = $admin->get_salutations();
+
+ my $entity = $admin->save_user();
+ if ($entity == 8){ # Duplicate user
+ $request->{import} = 1;
+ $request->{reimport} = 1;
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ template => 'Admin/edit_user',
+ language => $request->{_user}->{language},
+ format => 'HTML',
+ path=>'UI'
+ );
+ my $dcsetting = LedgerSMB::Setting->new(base=>$request, copy=>'base');
+ my $default_country = $dcsetting->get('default_country');
+ $template->render(
+ {
+ user=>{user => $request, employee => $request},
+ countries=>$admin->get_countries(),
+ salutations=>$admin->get_salutations(),
+ contact_classes=>$admin->get_contact_classes(),
+ default_country => $dcsetting->{value},
+ admin => $admin,
+ stylesheet => $request->{stylesheet},
+ }
+ );
+ return;
+ }
+ my $groups = $admin->get_roles();
+ $admin->{stylesheet} = $request->{stylesheet};
+ $admin->{user_id} = $admin->{user}->{id};
+ __edit_page($admin);
+}
+
+=item save_roles
+
+Saves the role assignments for a given user
+
+=cut
+
+sub save_roles {
+ my ($request, $admin) = @_;
+ my $admin = LedgerSMB::DBObject::Admin->new(base=>$request, copy=>'all');
+ $admin->{stylesheet} = $request->{stylesheet};
+ $admin->save_roles();
+ __edit_page($admin);
+}
+
+=item new_user
+
+Displays a new user form. No inputs used.
+
+=cut
+
+sub new_user {
+
+ # uses the same page as create_user, only pre-populated.
+ #my ($request) = @_;
+ my $request = shift @_;
+ my $admin = LedgerSMB::DBObject::Admin->new(base=>$request, copy=>'all');
+
+ my $sal = $admin->get_salutations();
+
+ my $groups = $admin->get_roles();
+ my $user = $request->{_user};
+
+ $logger->debug("scripts/admin.pl new_user: \$user = " . Data::Dumper::Dumper($user));
+
+ my $template = LedgerSMB::Template->new(
+ user => $user,
+ template => 'Admin/edit_user',
+ language => $user->{language},
+ format => 'HTML',
+ path=>'UI'
+ );
+
+ $template->render(
+ {
+ salutations=>$sal,
+ roles=>$groups,
+ countries=>$admin->get_countries(),
+ stylesheet => $request->{stylesheet},
+ user => { user => $request, employee => $request },
+ }
+ );
+}
+
+=item edit_user
+
+Displays the screen for editing a user. user_id must be set to prepopulate.
+
+=cut
+
+sub edit_user {
+
+ # uses the same page as create_user, only pre-populated.
+ my ($request) = @_;
+ __edit_page($request);
+}
+
+=item delete_user
+
+Deletes a user and returns to search results.
+
+=cut
+
+sub delete_user {
+ my ($request) = @_;
+ my $admin = LedgerSMB::DBObject::Admin->new({base => $request});
+ $admin->delete_user($request->{delete_user});
+ delete $request->{username};
+ search_users($request);
+}
+
+=item save_contact
+
+Saves contact information and returns to the edit user screen.
+
+=cut
+
+sub save_contact {
+
+ my $request = shift @_;
+
+ # Only ever a post, but check anyway
+ if ($request->type eq "POST") {
+
+ if ($request->{cancel}) {
+
+ # If we have a cancel request, we just go back to edit_page.
+ return __edit_page($request);
+ }
+
+ # We have a contact ID, ie, something we made up.
+ my $c_id = $request->{contact_id};
+ my $u_id = $request->{user_id};
+ my $user_obj = LedgerSMB::DBObject::User->new(base=>$request, copy=>'list', merge=>['user_id','company']);
+ $user_obj->get($u_id);
+
+ # so we have a user object.
+ # ->{contacts} is an arrayref to the list of contacts this user has
+ # $request->{contact_id} is a reference to this structure.
+
+ $user_obj->save_contact($c_id, $request->{contact_class}, $request->{contact});
+
+ __edit_page($request,{});
+ }
+}
+
+=item delete_contact
+
+Deletes contact information and returns to edit user screen
+
+=cut
+
+sub delete_contact {
+
+
+ my $request = shift @_;
+
+ # Only ever a post, but check anyway
+ if ($request->type eq "POST") {
+
+ if ($request->{cancel}) {
+
+ # If we have a cancel request, we just go back to edit_page.
+ return __edit_page($request);
+ }
+
+ # We have a contact ID, ie, something we made up.
+ my $c_id = $request->{contact_id};
+ my $u_id = $request->{user_id};
+ my $user = LedgerSMB::DBObject::User->new(base=>$request, copy=>'user_id');
+ $user->get($u_id);
+
+ # so we have a user object.
+ # ->{contacts} is an arrayref to the list of contacts this user has
+ # $request->{contact_id} is a reference to this structure.
+
+ $user->delete_contact($c_id);
+ # Boom. Done.
+ # Now, just call the main edit user page.
+
+ __edit_page($request,undef,);
+ }
+}
+
+=item search_users
+
+Displays search criteria screen
+
+=cut
+
+sub search_users {
+ my ($request) = @_;
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ template => 'Admin/user_search',
+ locale => $request->{_locale},
+ format => 'HTML',
+ path=>'UI'
+ );
+ $template->render($request);
+}
+
+=item get_user_results
+
+Displays user search results
+
+=cut
+
+#XXX Add delete link
+sub get_user_results {
+ my ($request) = @_;
+ my $admin = LedgerSMB::DBObject::Admin->new(base => $request);
+ my @users = $admin->search_users;
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ template => 'form-dynatable',
+ locale => $request->{_locale},
+ format => 'HTML',
+ path=>'UI'
+ );
+ my $columns;
+ @$columns = qw(id username first_name last_name ssn dob edit remove drop);
+
+ my $column_names = {
+ id => 'ID',
+ username => 'Username',
+ first_name => 'First Name',
+ last_name => 'Last Name',
+ ssn => 'Tax ID',
+ dob => 'Date of Birth'
+ };
+ my $column_heading = $template->column_heading($column_names);
+
+ my $rows = [];
+ my $rowcount = "0";
+ my $base_url = "admin.pl";
+ for my $u (@users) {
+ $u->{i} = $rowcount % 2;
+ $u->{edit} = {
+ href =>"$base_url?action=edit_user&user_id=$u->{id}",
+ text => '[' . $request->{_locale}->text('edit') . ']',
+ };
+ $u->{remove} = {
+ href => "$base_url?action=delete_user&username=$u->{username}",
+ text => '[' . $request->{_locale}->text('Delete') . ']',
+ };
+ $u->{drop} = {
+ href=>"$base_url?action=delete_user&username=$u->{username}&delete_role=1",
+ text=>'[' . $request->{_locale}->text('Drop from All') . ']',
+ };
+ push @$rows, $u;
+ ++$rowcount;
+ }
+ $admin->{title} = $request->{_locale}->text('Search Results');
+ $template->render({
+ form => $admin,
+ columns => $columns,
+ heading => $column_heading,
+ rows => $rows,
+ buttons => [],
+ hiddens => [],
+ });
+}
+
+=item list_sessions
+
+Displays a list of open sessions. No inputs required or used.
+
+=cut
+
+sub list_sessions {
+ my ($request) = @_;
+ my $admin = LedgerSMB::DBObject::Admin->new(base => $request);
+ my @sessions = $admin->list_sessions();
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ template => 'form-dynatable',
+ locale => $request->{_locale},
+ format => 'HTML',
+ path=>'UI'
+ );
+ my $columns;
+ @$columns = qw(id username last_used locks_active drop);
+ my $column_names = {
+ id => 'ID',
+ username => 'Username',
+ last_used => 'Last Used',
+ locks_active => 'Transactions Locked'
+ };
+ my $column_heading = $template->column_heading($column_names);
+ my $rows = [];
+ my $rowcount = "0";
+ my $base_url = "admin.pl?action=delete_session";
+ for my $s (@sessions) {
+ $s->{i} = $rowcount % 2;
+ $s->{drop} = {
+ href =>"$base_url&session_id=$s->{id}",
+ text => '[' . $request->{_locale}->text('delete') . ']',
+ };
+ push @$rows, $s;
+ ++$rowcount;
+ }
+ $admin->{title} = $request->{_locale}->text('Active Sessions');
+ $template->render({
+ form => $admin,
+ columns => $columns,
+ heading => $column_heading,
+ rows => $rows,
+ buttons => [],
+ hiddens => [],
+ });
+
+}
+
+=item delete_session
+
+Deletes the session specified by $request->{session_id}
+
+=cut
+
+sub delete_session {
+ my ($request) = @_;
+ my $admin = LedgerSMB::DBObject::Admin->new(base => $request);
+ $admin->delete_session();
+ list_sessions($request);
+}
+
+eval { do "scripts/custom/admin.pl"};
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2010 LedgerSMB Core Team. This file is licensed under the GNU
+General Public License version 2, or at your option any later version. Please
+see the included License.txt for details.
+
+=cut
+
+
+1;
Copied: trunk/LedgerSMB/Scripts/asset.pl (from rev 3835, trunk/scripts/asset.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/asset.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/asset.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,1181 @@
+=pod
+
+=head1 NAME
+
+LedgerSMB::Scripts::asset
+
+=head1 SYNPOSIS
+
+Asset Management workflow script
+
+=head1 METHODS
+
+=over
+
+=cut
+
+package LedgerSMB::Scripts::asset;
+use LedgerSMB::Template;
+use LedgerSMB::DBObject::Asset_Class;
+use LedgerSMB::DBObject::Asset;
+use LedgerSMB::DBObject::Asset_Report;
+use strict;
+
+our @file_columns = qw(tag purchase_date description asset_class location vendor
+ invoice department asset_account purchase_value
+ accum_dep nbv start_depreciation usable_life
+ usable_life_remaining); # override in custom/asset.pl
+
+our $default_dep_account = '5010'; # Override in custom/asset.pl
+our $default_asset_account = '1300'; # Override in custom/asset.pl
+
+=item begin_depreciation_all
+
+Displays the depreciation screen for all asset classes.
+
+No inputs required. Those inputs expected for depreciate_all can be used to
+set defaults here.
+
+=cut
+
+sub begin_depreciation_all {
+ my ($request) = @_;
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/asset',
+ template => 'begin_depreciation_all',
+ format => 'HTML'
+ );
+ $template->render($request);
+}
+
+=item depreciate_all
+
+Creates a depreciation report for each asset class. Depreciates all assets
+
+Expects report_date to be set.
+
+=cut
+
+sub depreciate_all {
+ my ($request) = @_;
+ my $report = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $report->get_metadata;
+ for my $ac(@{$report->{asset_classes}}){
+ my $dep = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $dep->{asset_class} = $ac->{id};
+ $dep->generate;
+ for my $asset (@{$dep->{assets}}){
+ push @{$dep->{asset_ids}}, $asset->{id};
+ }
+ $dep->save;
+ }
+ $request->{message} = $request->{_locale}->text('Depreciation Successful');
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'info',
+ format => 'HTML'
+ );
+ $template->render($request);
+
+}
+
+=item asset_category_screen
+
+Asset class (edit create class)
+
+No inputs required. Standard properties for asset_class used to populate form
+if they are provided.
+
+=cut
+
+sub asset_category_screen {
+ my ($request) = @_;
+ if ($request->{id}){
+ $request->{title} = $request->{_locale}->text('Edit Asset Class');
+ } else {
+ $request->{title} = $request->{_locale}->text('Add Asset Class');
+ }
+ my $ac = LedgerSMB::DBObject::Asset_Class->new(base => $request);
+ $ac->get_metadata;
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/asset',
+ template => 'edit_class',
+ format => 'HTML'
+ );
+ $template->render($ac);
+}
+
+=item asset_category_save
+
+Saves the asset class information provided.
+See LedgerSMB::DBObject::Asset_report for standard properties. ID is optional.
+Others are required.
+
+=cut
+
+sub asset_category_save {
+ my ($request) = @_;
+ my $ac = LedgerSMB::DBObject::Asset_Class->new(base => $request);
+ $ac->save;
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/asset',
+ template => 'edit_class',
+ format => 'HTML'
+ );
+ $template->render($ac);
+}
+
+# Is this even working at the moment? Not documenting unil I know.
+
+sub asset_category_search {
+ my ($request) = @_;
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/asset',
+ template => 'search_class',
+ format => 'HTML'
+ );
+ $template->render($request);
+}
+
+=item asset_category_results
+
+Displays a list of all asset classes. No inputs required.
+
+=cut
+
+sub asset_category_results {
+ my ($request) = @_;
+ my $ac = LedgerSMB::DBObject::Asset_Class->new(base => $request);
+ my @classes = $ac->list_asset_classes();
+ my $locale = $request->{_locale};
+ $ac->get_metadata;
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'form-dynatable',
+ format => 'HTML'
+ );
+ my $columns;
+ @$columns = qw(id label dep_method asset_account dep_account);
+ my $heading = {
+ id => $locale->text('ID'),
+ label => $locale->text('Description'),
+ asset_account => $locale->text('Asset Account'),
+ dep_account => $locale->text('Depreciation Account'),
+ dep_method => $locale->text('Depreciation Method')
+ };
+
+ my $rows = [];
+ my $a_accs = {};
+ for my $a_acc (@{$ac->{asset_accounts}}){
+ $a_accs->{$a_acc->{id}} = $a_acc;
+ }
+ my $d_accs = {};
+ for my $d_acc (@{$ac->{dep_accounts}}){
+ $d_accs->{$d_acc->{id}} = $d_acc;
+ }
+ for my $aclass (@{$ac->{classes}}) {
+ print STDERR "$aclass\n";
+ my $a_acc = $a_accs->{$aclass->{asset_account_id}};
+ my $d_acc = $d_accs->{$aclass->{dep_account_id}};
+ my $href = "asset.pl?action=edit_asset_class";
+ my $row = {
+ id => $aclass->{id},
+ label => {
+ text => $aclass->{label},
+ href => "$href&id=$aclass->{id}",
+ },
+ dep_method => $aclass->{dep_method},
+ life_unit => $aclass->{life_unit},
+ asset_account => $a_acc->{text},
+ dep_account => $d_acc->{text},
+ };
+ push @$rows, $row;
+ }
+ $template->render({
+ form => $ac,
+ heading => $heading,
+ rows => $rows,
+ columns => $columns,
+ });
+}
+
+=item edit_asset_class
+
+Edits an asset class. Expects id to be set.
+
+=cut
+
+sub edit_asset_class {
+ my ($request) = @_;
+ my $ac = LedgerSMB::DBObject::Asset_Class->new(base => $request);
+ $ac->get_asset_class;
+ asset_category_screen($ac);
+}
+
+=item asset_edit
+
+Displats the edit screen for an asset item. Tag or id must be set.
+
+=cut
+
+sub asset_edit {
+ my ($request) = @_;
+ my $asset = LedgerSMB::DBObject::Asset->new(base => $request);
+ $asset->get();
+ $asset->get_metadata();
+ for my $label (qw(purchase_value salvage_value usable_life)){
+ $asset->{$label} = $asset->format_amount({amount => $asset->{$label}});
+ }
+ asset_screen($asset);
+}
+
+=item
+
+Screen to create a new asset.
+
+No inputs required, any standard properties from LedgerSMB::DBObject::Asset
+can be used to set defaults.
+
+=cut
+
+sub asset_screen {
+ my ($request) = @_;
+ my $asset = LedgerSMB::DBObject::Asset->new(base => $request);
+ $asset->get_metadata;
+ if (!$asset->{tag}){
+ $asset->get_next_tag;
+ }
+ $asset->{title} = $request->{_locale}->text('Add Asset')
+ unless $asset->{title};
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/asset',
+ template => 'edit_asset',
+ format => 'HTML'
+ );
+ $template->render($asset);
+}
+
+=item asset_search
+
+Displays the search screen for asset items. No inputs required.
+
+Any inputs for asset_results can be used here to set defaults.
+
+=cut
+
+sub asset_search {
+ my ($request) = @_;
+ my $asset = LedgerSMB::DBObject::Asset->new(base => $request);
+ $asset->get_metadata;
+ unshift @{$asset->{asset_classes}}, {};
+ unshift @{$asset->{locations}}, {};
+ unshift @{$asset->{departments}}, {};
+ unshift @{$asset->{asset_accounts}}, {};
+ unshift @{$asset->{dep_accounts}}, {};
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/asset',
+ template => 'search_asset',
+ format => 'HTML'
+ );
+ $template->render($asset);
+}
+
+=item asset_results
+
+Searches for asset items and displays them
+
+See LedgerSMB::DBObject::Asset->search() for a list of search criteria that can
+be set.
+
+=cut
+
+sub asset_results {
+ my ($request) = @_;
+ my $locale = $request->{_locale};
+ my $asset = LedgerSMB::DBObject::Asset->new(base => $request);
+ $asset->get_metadata;
+ if (!$asset->{usable_life}){
+ delete $asset->{usable_life};
+ }
+ my @items = $asset->search();
+ my $columns = ['tag', 'description', 'class', 'purchase_date',
+ 'purchase_value', 'usable_life', 'location', 'department'];
+ my $heading = { tag => $locale->text('Tag'),
+ description => $locale->text('Description'),
+ purchase_date => $locale->text('Purchase Date'),
+ purchase_value => $locale->text('Purchase Value'),
+ class => $locale->text('Class'),
+ usable_life => $locale->text('Usable Life'),
+ location => $locale->text('Location'),
+ department => $locale->text('Department'),
+ };
+ my $asset_classes = {};
+ for my $ac(@{$asset->{asset_classes}}){
+ $asset_classes->{$ac->{id}} = $ac;
+ }
+ my $departments = {};
+ for my $dept(@{$asset->{departments}}){
+ $departments->{$dept->{id}} = $dept;
+ }
+ my $locations = {};
+ for my $loc(@{$asset->{asset_classes}}){
+ $locations->{$loc->{id}} = $loc;
+ }
+ my $rows = [];
+ for my $item (@items){
+ my $ref = {};
+ for my $label (qw(id description purchase_date purchase_value
+ usable_life)){
+ $ref->{$label} = $item->{$label};
+ }
+ $ref->{tag} = { href => "asset.pl?action=asset_edit&id=$item->{id}",
+ text => $item->{tag},
+ };
+ for my $label (qw(purchase_value usable_life)){
+ $ref->{$label} = $asset->format_amount({amount => $ref->{$label}});
+ }
+ $ref->{class} = $asset_classes->{$item->{asset_class_id}}->{label};
+ $ref->{department}
+ = $departments->{$item->{department_id}}->{description};
+ $ref->{location} = $locations->{$item->{location_id}}->{description};
+ push @$rows, $ref;
+ }
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'form-dynatable',
+ format => 'HTML'
+ );
+ $template->render({
+ form => $asset,
+ heading => $heading,
+ rows => $rows,
+ columns => $columns,
+ });
+}
+
+=item asset_save
+
+Saves the asset. See LedgerSMB::DBObject::Asset->save() for more info.
+
+Additionally this also creates a note with the vendor number and invoice number
+for future reference, since this may not have been entered specifically as a
+vendor transaction in LedgerSMB.
+
+=cut
+
+sub asset_save {
+ my ($request) = @_;
+ my $asset = LedgerSMB::DBObject::Asset->new(base => $request);
+ for my $number (qw(salvage_value purchase_value usable_life)){
+ $asset->{"$number"} = $asset->parse_amount(
+ user => $asset->{_user}, amount => $asset->{"$number"}
+ );
+ }
+ $asset->save;
+ $asset->{note} = 'Vendor:' . $asset->{meta_number} . "\n"
+ . 'Invoice:'.$asset->{invnumber};
+ $asset->{subject} = 'Vendor/Invoice Note';
+ $asset->save_note;
+ my $newasset = LedgerSMB::DBObject::Asset->new(
+ base => $request,
+ copy => 'list',
+ merge => ['stylesheet'],
+ );
+ asset_screen($newasset);
+}
+
+=item new_report
+
+Starts the new report workflow. No inputs required.
+
+report_init inputs can be used to set defaults.
+
+=cut
+
+sub new_report {
+ my ($request) = @_;
+ my $report = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $report->get_metadata;
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/asset',
+ template => 'begin_report',
+ format => 'HTML'
+ );
+ $template->render($report);
+}
+
+=item report_init
+
+Creates a report and populates the screen with possible report lines.
+
+Inputs expected:
+* report_id int: Report to enter the transactions into,
+* accum_account_id int: ID for accumulated depreciation.
+
+=cut
+
+sub report_init {
+ my ($request) = @_;
+ my $report = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $report->generate;
+ display_report($report);
+}
+
+=item report_save
+
+Saves the report.
+
+see LedgerSMB::DBObject::Asset_Report->save() for expected inputs.
+
+=cut
+
+sub report_save{
+ my ($request) = @_;
+ my $report = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $report->{asset_ids} = [];
+ for my $count (0 .. $request->{rowcount}){
+ my $id = $request->{"id_$count"};
+ if ($request->{"asset_$count"}){
+ push @{$report->{asset_ids}}, $id;
+ }
+ }
+ $report->save;
+ my $ar = LedgerSMB::DBObject::Asset_Report->new(
+ base => $request,
+ copy => 'base'
+ );
+ new_report($request);
+}
+
+=item report_get
+
+Retrieves the report identified by the id input and displays it.
+
+=cut
+
+sub report_get {
+ my ($request) = @_;
+ my $report = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $report->get;
+ display_report($report);
+}
+
+=item display_report
+
+Not directly called. This routine displays a report that is set up.
+
+Assumes that all standard properties of LedgerSMB::DBObject::Asset_Report are
+set, and also requires $request->{assets} is an array ref to the report line
+items. Each has the standard properties of the LedgerSMB::DBObject::Asset plus
+dm (disposal method id) and amount (amount to depreciate).
+
+=cut
+
+sub display_report {
+ my ($request) = @_;
+ my $report = LedgerSMB::DBObject::Asset_Report->new({base => $request});
+ $report->get_metadata;
+ my $locale = $request->{_locale};
+ my $cols = [];
+ @$cols = qw(select tag description purchase_date purchase_value);
+ my $heading = {
+ tag => $locale->text('Asset Tag') ,
+ description => $locale->text('Description') ,
+ purchase_date => $locale->text('Purchase Date') ,
+ purchase_value => $locale->text('Purchase Value') ,
+ amount => $locale->text('Proceeds'),
+ dm => $locale->text('Disposal Method'),
+ percent => $locale->text('Percent'),
+ };
+ my $rows = [];
+ my $hiddens = {};
+ my $count = 0;
+ for my $asset (@{$request->{assets}}){
+ push @$rows,
+ { select => {input => { name => "asset_$count",
+ checked => $asset->{checked},
+ type => "checkbox",
+ value => '1',
+ },
+ },
+ tag => $asset->{tag},
+ description => $asset->{description},
+ purchase_date => $asset->{purchase_date},
+ purchase_value => $request->format_amount(
+ amount => $asset->{purchase_value}
+ ),
+ dm => {select => { name => "dm_$asset->{id}",
+ options => $report->{disp_methods},
+ text_attr => 'label',
+ value_attr => 'id',
+ },
+ },
+
+ amount => {input => { name => "amount_$asset->{id}",
+ type => 'text',
+ class => 'amount',
+ value => $request->{"amount_$asset->{id}"},
+ size => 20,
+ },
+ },
+ percent => {input => { name => "percent_$asset->{id}",
+ type => 'text',
+ class => 'percent',
+ value => $request->{"percent_$asset->{id}"},
+ size => 6,
+ },
+ },
+ };
+ $hiddens->{"id_$count"} = $asset->{id};
+ ++$count;
+ }
+ $request->{rowcount} = $count;
+ my $buttons = [
+ { name => 'action',
+ text => $locale->text('Save'),
+ value => 'report_save',
+ class => 'submit',
+ type => 'submit',
+ },
+ ];
+ if ($request->{depreciation}){
+ $request->{title} = $locale->text('Asset Depreciation Report');
+ } else {
+ $request->{title} = $locale->text('Asset Disposal Report');
+ push @$cols, 'dm', 'amount';
+ $hiddens->{report_class} = $request->{report_class};
+ }
+ if ($request->{report_class} == 4){
+ $request->{title} = $locale->text('Asset Partial Disposal Report');
+ push @$cols, 'percent';
+ }
+ for my $hide (qw(exp_account_id gain_account_id loss_account_id report_date
+ asset_class rowcount depreciation))
+ {
+ $hiddens->{$hide} = $request->{$hide};
+ }
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'form-dynatable',
+ format => 'HTML'
+ );
+ $template->render({ form => $request,
+ columns => $cols,
+ heading => $heading,
+ rows => $rows,
+ hiddens => $hiddens,
+ buttons => $buttons,
+ });
+}
+
+=item search_reports
+
+Displays search report filter. The only input expected is depreciation which if
+set and true makes this a depreciation report.
+
+Any other inputs required by
+report_results can be used here to set defaults. See the required inputs for
+LedgerSMB::DBObject::Asset_Report->search() for a list of such inputs.
+
+=cut
+
+sub search_reports {
+ my ($request) = @_;
+ $request->{title} = $request->{_locale}->text('Search reports');
+ my $ar = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $ar->get_metadata;
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/asset',
+ template => 'begin_approval',
+ format => 'HTML'
+ );
+ $template->render($ar);
+}
+
+=item report_results
+
+Executes the search for asset reports and displays the results. See the
+required inputs for LedgerSMB::DBObject::Asset_Report->search() for a list of
+inputs.
+
+=cut
+
+sub report_results {
+ my ($request) = @_;
+ my $locale = $request->{_locale};
+ my $ar = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $ar->get_metadata;
+ $ar->{title} = $locale->text('Report Results');
+ my @results = $ar->search;
+ my $cols = [];
+ @$cols = qw(select id report_date type asset_class entered_at
+ approved_at total);
+ my $header = {
+ id => $locale->text('ID'),
+ report_date => $locale->text('Date'),
+ type => $locale->text('Type'),
+ asset_class => $locale->text('Asset Class'),
+ entered_at => $locale->text('Entered at'),
+ approved_at => $locale->text('Approved at'),
+ total => $locale->text('Total'),
+ };
+ my $rows = [];
+ my $hiddens = {};
+ my $count = 0;
+ my $base_href = "asset.pl?action=report_details&".
+ "expense_acct=$ar->{expense_acct}";
+ if ($ar->{depreciation}){
+ $base_href .= '&depreciation=1';
+ } else {
+ $base_href .= "&gain_acct=$ar->{gain_acct}&loss_acct=".
+ "$ar->{loss_acct}";
+ }
+ for my $r (@results){
+ next if (($r->{report_class} != 1 and $ar->{depreciation})
+ or ($r->{report_class} == 1 and !$ar->{depreciation}));
+ $hiddens->{"id_$count"} = $r->{id};
+ my $ref = {
+ select => {input => { name => "report_$count",
+ checked => $r->{checked},
+ type => "checkbox",
+ value => $r->{id},
+ },
+ },
+ id => {href => $base_href . "&id=".$r->{id},
+ text => $r->{id},
+ },
+ report_date => $r->{report_date},
+ entered_at => $r->{entered_at},
+ approved_at => $r->{approved_at},
+ total => $ar->format_amount({amount => $r->{total},
+ money => 1}),
+ };
+ for my $ac (@{$ar->{asset_classes}}){
+ if ($ac->{id} = $r->{asset_class}){
+ $ref->{asset_class} = $ac->{label};
+ }
+ }
+ if ($r->{report_class} == 1){
+ $ref->{type} = $locale->text('Depreciation');
+ } else {
+ $ref->{type} = $locale->text('Disposal');
+ }
+ push @$rows, $ref;
+ ++$count;
+ }
+ $request->{rowcount} = $count;
+ my $buttons = [{
+ text => $locale->text('Approve'),
+ type => 'submit',
+ class => 'submit',
+ name => 'action',
+ value => 'approve'
+ },
+ ];
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'form-dynatable',
+ format => 'HTML'
+ );
+ $template->render({
+ form => $ar,
+ heading => $header,
+ rows => $rows,
+ columns => $cols,
+ hiddens => $request,
+ buttons => $buttons,
+ });
+}
+
+=item report_details
+
+Displays the details of an existing report. Requires that the id request arg is
+set which represents the id of the report.
+
+=cut
+
+sub report_details {
+ my ($request) = @_;
+ my $locale = $request->{_locale};
+ my $report = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $report->get;
+ if ($report->{report_class} == 2) {
+ disposal_details($report);
+ exit;
+ } elsif ($report->{report_class} == 4) {
+ partial_disposal_details($report);
+ exit;
+ }
+ my @cols = qw(tag start_depreciation purchase_value method_short_name
+ usable_life basis prior_through prior_dep dep_this_time
+ dep_ytd dep_total);
+ $report->{title} = $locale->text("Report [_1] on date [_2]",
+ $report->{id}, $report->{report_date});
+ my $header = {
+ tag => $locale->text('Tag'),
+ start_depreciation => $locale->text('Dep. Starts'),
+ purchase_value =>$locale->text('Aquired Value'),
+ method_short_name =>$locale->text('Dep. Method'),
+ usable_life =>$locale->text('Est. Life'),
+ basis =>$locale->text('Dep. Basis'),
+ prior_through =>$locale->text('Prior Through'),
+ prior_dep =>$locale->text('Prior Dep.'),
+ dep_this_time =>$locale->text('Dep. this run'),
+ dep_ytd =>$locale->text('Dep. YTD'),
+ dep_total =>$locale->text('Total Accum. Dep.'),
+ };
+ my $rows = [];
+ for my $r (@{$report->{report_lines}}){
+ $r->{usable_life} = $report->format_amount({amount => $r->{usable_life}});
+ for my $amt (qw(purchase_value basis prior_dep dep_this_time dep_ytd
+ dep_total)){
+ $r->{$amt} = $report->format_amount({amount => $r->{$amt},
+ money => 1,});
+ }
+ push @$rows, $r;
+ }
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'form-dynatable',
+ format => 'HTML'
+ );
+ my $buttons = [{
+ text => $locale->text('Approve'),
+ type => 'submit',
+ class => 'submit',
+ name => 'action',
+ value => 'approve'
+ },
+ ];
+ $template->render({form => $report,
+ columns => ..hidden..,
+ heading => $header,
+ rows => $rows,
+ hiddens => $report,
+ buttons => $buttons
+ });
+}
+
+=item partial_disposal_details
+
+Displays the results of a partial disposal report. The id must be set to the
+id of the report desired.
+
+=cut
+
+sub partial_disposal_details {
+ my ($request) = @_;
+ my $locale = $request->{_locale};
+ my $report = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $report->get;
+ my @cols = qw(tag begin_depreciation purchase_value description
+ percent_disposed disposed_acquired_value
+ percent_remaining remaining_aquired_value);
+ $report->{title} = $locale->text("Partial Disposal Report [_1] on date [_2]",
+ $report->{id}, $report->{report_date});
+ my $header = {
+ tag => $locale->text('Tag'),
+ description => $locale->text('Description'),
+ begin_depreciation => $locale->text('Dep. Starts'),
+ purchase_value => $locale->text('Aquired Value'),
+ percent_disposed => $locale->text('Percent Disposed'),
+ disposed_acquired_value =>
+ $locale->text('Disp. Aquired Value'),
+ percent_remaining => $locale->text('Percent Remaining'),
+ remaining_aquired_value =>
+ $locale->text('Aquired Value Remaining')
+ };
+ my $rows = [];
+ for my $r (@{$report->{report_lines}}){
+ $r->{usable_life} = $report->format_amount({amount => $r->{usable_life}});
+ for my $amt (qw(purchase_value adj_basis disposed_acquired_value
+ remaining_aquired_value percent_disposed
+ percent_remaining)
+ ){
+ $r->{$amt} = $report->format_amount(
+ {amount => $r->{$amt},
+ money => 1,
+ }
+ );
+ }
+ $r->{gain_loss} = $report->format_amount({amount => $r->{gain_loss},
+ money => 1,
+ neg_format => '-' } );
+ push @$rows, $r;
+ }
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'form-dynatable',
+ format => 'HTML'
+ );
+ my $buttons = [{
+ text => $locale->text('Approve'),
+ type => 'submit',
+ class => 'submit',
+ name => 'action',
+ value => 'approve'
+ },
+ ];
+ $template->render({form => $report,
+ columns => ..hidden..,
+ heading => $header,
+ rows => $rows,
+ hiddens => $report,
+ buttons => $buttons
+ });
+}
+
+=item disposal_details
+
+Displays the details of a disposal report.
+
+id must be set to the id of the report to be displayed.
+
+=cut
+
+sub disposal_details {
+ my ($request) = @_;
+ my $locale = $request->{_locale};
+ my $report = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $report->get;
+ my @cols = qw(tag description start_dep disposed_on dm purchase_value
+ accum_depreciation adj_basis disposal_amt gain_loss);
+ $report->{title} = $locale->text("Disposal Report [_1] on date [_2]",
+ $report->{id}, $report->{report_date});
+ my $header = {
+ tag => $locale->text('Tag'),
+ description => $locale->text('Description'),
+ start_dep => $locale->text('Dep. Starts'),
+ disposed_on => $locale->text('Disposal Date'),
+ purchase_value => $locale->text('Aquired Value'),
+ dm => $locale->text('D M'),
+ accum_depreciation => $locale->text('Accum. Depreciation'),
+ disposal_amt => $locale->text('Proceeds'),
+ adj_basis => $locale->text('Adjusted Basis'),
+ gain_loss => $locale->text('Gain (Loss)'),
+ };
+ my $rows = [];
+ for my $r (@{$report->{report_lines}}){
+ $r->{usable_life} = $report->format_amount({amount => $r->{usable_life}});
+ for my $amt (qw(purchase_value adj_basis accum_depreciation
+ disposal_amt)
+ ){
+ $r->{$amt} = $report->format_amount({amount => $r->{$amt},
+ money => 1,});
+ }
+ $r->{gain_loss} = $report->format_amount({amount => $r->{gain_loss},
+ money => 1,
+ neg_format => '-' } );
+ push @$rows, $r;
+ }
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'form-dynatable',
+ format => 'HTML'
+ );
+ my $buttons = [{
+ text => $locale->text('Approve'),
+ type => 'submit',
+ class => 'submit',
+ name => 'action',
+ value => 'approve'
+ },
+ ];
+ $template->render({form => $report,
+ columns => ..hidden..,
+ heading => $header,
+ rows => $rows,
+ hiddens => $report,
+ buttons => $buttons
+ });
+}
+
+=sub disposal_details_approve
+
+Pass through function for form-dynatable's action munging. An lias for
+report_details_approve.
+
+=cut
+
+sub disposal_details_approve {
+ report_details_approve(@_);
+}
+
+=iten report_details_approve
+
+Approves disposal details. id must be set,
+
+For disposal reports, gain_acct and loss_acct must be set to appropriate
+account id's.
+
+For depreciation reports, expense_acct must be set to an appropriate accont id.
+
+=cut
+
+sub report_details_approve {
+ my ($request) = @_;
+ my $report = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $report->approve;
+ search_reports($request);
+}
+
+=item report_results_approve
+
+Loops through the input and approves all selected reports.
+
+For disposal reports, gain_acct and loss_acct must be set to appropriate
+account id's.
+
+For depreciation reports, expense_acct must be set to an appropriate accont id.
+
+For each row, there is report_$id field which if set to a true value, indicates
+a report to be approved.
+
+=cut
+
+sub report_results_approve {
+ my ($request) = @_;
+ for my $l (0 .. $request->{rowcount}){
+ if ($request->{"report_$l"}){
+ my $approved = LedgerSMB::DBObject::Asset_Report->new(base => $request);
+ $approved->{id} = $request->{"report_$l"};
+ $approved->approve;
+ }
+ }
+ search_reports($request);
+
+}
+
+# I don't believe this is used, Not documenting for now. --CT
+
+sub begin_nbv {
+ my ($request) = @_;
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/asset',
+ template => 'nbv_filter',
+ format => 'HTML'
+ );
+ $template->render($request);
+}
+
+=item display_nbv
+
+Displays the net book value report, namely the current net value of all active
+active assets.
+
+No inputs required or used.
+
+=cut
+
+sub display_nbv {
+ my ($request) = @_;
+ my $locale = $request->{_locale};
+ my $report = LedgerSMB::DBObject::Asset_Report->new({base => $request });
+ my @cols = qw(id tag description begin_depreciation method remaining_life basis salvage_value
+ through_date accum_depreciation net_book_value);
+ my $header = {
+ id => $locale->text('ID'),
+ tag => $locale->text('Tag'),
+ description => $locale->text('Description'),
+ begin_depreciation => $locale->text('In Svc.'),
+ method => $locale->text('Method'),
+ remaining_life => $locale->text('Rem. Life'),
+ basis => $locale->text('Basis'),
+ salvage_value => $locale->text('(+) Salvage Value'),
+ through_date => $locale->text('Dep. through'),
+ accum_depreciation => $locale->text('(-) Accum. Dep.'),
+ net_book_value => $locale->text('(=) NBV'),
+ percent_depreciated => $locale->text('Pct. Dep.'),
+ };
+ my @results = $report->get_nbv;
+ my $rows = [];
+ for my $r(@results){
+ for my $amt (qw(basis salvage_value accum_depreciation net_book_value)){
+ $r->{$amt} = $request->format_amount({amount => $r->{$amt}, money => 1});
+ }
+ for my $amt (qw(percent_depreciated remaining_life)){
+ $r->{$amt} = $request->format_amount({amount => $r->{$amt}});
+ }
+ push @$rows, $r;
+ }
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'form-dynatable',
+ format => 'HTML'
+ );
+ $template->render({form => $report,
+ columns => ..hidden..,
+ heading => $header,
+ rows => $rows,
+ });
+}
+
+=item begin_import
+
+Displays the initial screen for asset import routines.
+
+No inputs required.
+
+=cut
+
+sub begin_import {
+ my ($request) = @_;
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/asset',
+ template => 'import_asset',
+ format => 'HTML'
+ );
+ $template->render($request);
+}
+
+=item run_import
+
+Runs the actual import based on a CSV file. This is tested primarily against
+Excel for the Mac which has known CSV generation problems, and Gnumeric which
+produces very good CSV. It should work on most CSV files if the format is
+consistent.
+
+See the Customization Notes section below for more info on how to set up
+CSV formats.
+
+=cut
+
+sub run_import {
+
+ my ($request) = @_;
+ my $asset = LedgerSMB::DBObject::Asset->new({base => $request});
+ $asset->get_metadata;
+
+ my @rresults = $asset->call_procedure(
+ procname => 'asset_report__begin_import',
+ args => [$asset->{asset_classes}->[0]->{id},
+ $asset->{report_date}]
+ );
+ my $report_results = shift @rresults;
+ my $department = {};
+ my $location = {};
+ my $class = {};
+ my $asset_account = {};
+ my $dep_account = {};
+ for my $c (@{$asset->{asset_classes}}){
+ $class->{"$c->{label}"} = $c;
+ }
+ for my $l (@{$asset->{locations}}){
+ $location->{"$l->{description}"} = $l->{id};
+ }
+ for my $d (@{$asset->{departments}}){
+ $department->{"$d->{description}"} = $d->{id};
+ }
+ for my $a (@{$asset->{asset_accounts}}){
+ $asset_account->{"$a->{accno}"} = $a;
+ }
+ for my $a (@{$asset->{dep_accounts}}){
+ $dep_account->{"$a->{accno}"} = $a;
+ }
+ for my $ail ($asset->import_file($request->{import_file})){
+ my $ai = LedgerSMB::DBObject::Asset->new({copy => 'base', base => $request});
+ for (0 .. $#file_columns){
+ $ai->{$file_columns[$_]} = $ail->[$_];
+ }
+ next if $ai->{purchase_value} !~ /\d/;
+ $ai->{purchase_value} = $ai->parse_amount(amount => $ai->{purchase_value});
+ $ai->{accum_dep} = $ai->parse_amount(amount => $ai->{accum_dep});
+ $ai->{dep_account} = $default_dep_account if !$ai->{dep_account};
+ $ai->{asset_account} = $default_asset_account if !$ai->{dep_account};
+ if (!$ai->{start_depreciation}){
+ $ai->{start_depreciation} = $ai->{purchase_date};
+ }
+ if ($ai->{asset_class} !~ /Leasehold/i){
+ $ai->{usable_life} = $ai->{usable_life}/12;
+ }
+ $ai->{dep_report_id} = $report_results->{id};
+ $ai->{location_id} = $location->{"$ai->{location}"};
+ $ai->{department_id} = $department->{"$ai->{department}"};
+ $ai->{asset_class_id} = $class->{"$ai->{asset_class}"}->{id};
+ $ai->{dep_account_id} = $class->{"$ai->{asset_class}"}->{dep_account_id};
+ $ai->{asset_account_id} = $asset_account->{"$ai->{asset_account}"}->{id};
+ if (!$ai->{dep_account_id}){
+ $ai->{dep_account_id} = $dep_account->{$default_dep_account}->{id};
+ }
+ for my $l (@{$asset->{locations}}){
+ if ($ai->{location} eq $l->{description}){
+ $ai->{location} = $l->{id};
+ }
+ }
+ for my $l (@{$asset->{departments}}){
+ if ($ai->{location} eq $l->{description}){
+ $ai->{location} = $l->{id};
+ }
+ }
+ for my $l (@{$asset->{asset_classes}}){
+ if ($ai->{location} eq $l->{label}){
+ $ai->{location} = $l->{id};
+ }
+ }
+ for my $attr_name (qw(location department asset_class)){
+ my $attr = $ai->{$attr_name};
+ $ai->{$attr} = $asset->{"${attr}_name"};
+ }
+ $ai->import_asset;
+ }
+ $request->{dbh}->commit;
+ $request->{info} = $request->{_locale}->text('File Imported');
+ begin_import($request);
+}
+
+eval { do "scripts/custom/asset.pl"};
+
+1;
+
+=back
+
+=head1 CUSTOMIZATION NOTES
+
+The handling of CSV imports of fixed assets is handled by @file_columns. This
+can be set in a custom/ file.
+
+=head1 Copyright (C) 2010, The LedgerSMB core team.
+
+This file is licensed under the Gnu General Public License version 2, or at your
+option any later version. A copy of the license should have been included with
+your software.
+
+=cut
Copied: trunk/LedgerSMB/Scripts/customer.pl (from rev 3835, trunk/scripts/customer.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/customer.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/customer.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+=pod
+
+=head1 NAME
+
+LedgerSMB::Scripts::customer - LedgerSMB class defining the Controller
+functions, template instantiation and rendering for customer editing and display.
+
+=head1 SYOPSIS
+
+This module is the UI controller for the customer DB access; it provides the
+View interface, as well as defines the Save customer.
+Save customer will update or create as needed.
+
+
+=head1 METHODS
+
+=cut
+
+package LedgerSMB::Scripts::customer;
+
+use LedgerSMB::DBObject::Customer;
+use base qw(LedgerSMB::ScriptLib::Company);
+
+sub set_entity_class {
+ my ($null, $request) = @_;
+ $request->{entity_class} = 2;
+ $request->{account_class} = $request->{entity_class};
+ return 1;
+}
+
+sub new_company {
+ my ($null, $request) = @_;
+
+ return LedgerSMB::DBObject::Customer->new(base=> $request, copy => 'all');
+}
+
+
+=back
+
+=head1 INHERITS
+
+LedgerSMB::ScriptLib::Company
+
+=head1 COPYRIGHT
+
+Copyright (c) 2009, the LedgerSMB Core Team. This is licensed under the GNU
+General Public License, version 2, or at your option any later version. Please
+see the accompanying License.txt for more information.
+
+=cut
+
+1;
Copied: trunk/LedgerSMB/Scripts/drafts.pl (from rev 3835, trunk/scripts/drafts.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/drafts.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/drafts.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,266 @@
+=pod
+
+=head1 NAME
+
+LedgerSMB:Scripts::drafts, LedgerSMB workflow scripts for managing drafts
+
+=head1 SYNOPSIS
+
+This module contains the workflows for managing unapproved, unbatched financial
+transactions. This does not contain facities for creating such transactions,
+only searching for them, and posting them to the books or deleting those
+which have not been approved yet.
+
+=head1 METHODS
+
+=over
+
+=cut
+
+
+package LedgerSMB::Scripts::drafts;
+our $VERSION = '0.1';
+
+use LedgerSMB::DBObject::Draft;
+use LedgerSMB::Template;
+use strict;
+
+=item search
+
+Displays the search filter screen. No inputs required.
+
+The following inputs are optional and become defaults for the search criteria:
+
+type: either 'ar', 'ap', or 'gl'
+with_accno: Draft transaction against a specific account.
+from_date: Earliest date for match
+to_date: Latest date for match
+amount_le: total less than or equal to
+amount_ge: total greater than or equal to
+
+=cut
+
+sub search {
+ my ($request) = @_;
+ $request->{class_types} = [
+ {text => $request->{_locale}->text('AR'), value => 'ar'},
+ {text => $request->{_locale}->text('AP'), value => 'ap'},
+ {text => $request->{_locale}->text('GL'), value => 'gl'},
+ ];
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'batch/search_transactions',
+ format => 'HTML'
+ );
+ $template->render($request);
+}
+
+=item list_drafts_draft_approve
+
+Required hash entries (global):
+
+rowcount: number of total drafts in the list
+
+Required hash entries:
+row_$runningnumber: transaction id of the draft on that row.
+draft_$id: true if selected.
+
+
+Approves selected drafts. If close_form fails, does nothing and lists
+drafts again.
+
+=cut
+
+
+sub list_drafts_draft_approve {
+ my ($request) = @_;
+ if (!$request->close_form){
+ list_drafts($request);
+ $request->finalize_request();
+ }
+ my $draft= LedgerSMB::DBObject::Draft->new(base => $request);
+ for my $row (1 .. $draft->{rowcount}){
+ if ($draft->{"draft_" .$draft->{"row_$row"}}){
+ $draft->{id} = $draft->{"row_$row"};
+ $draft->approve;
+ }
+ }
+ search($request);
+}
+
+
+=item list_drafts_draft_delete
+
+Required hash entries (global):
+
+rowcount: number of total drafts in the list
+
+Required hash entries:
+row_$runningnumber: transaction id of the draft on that row.
+draft_$id: true if selected.
+
+
+Deletes selected drafts. If close_form fails, does nothing and lists
+drafts again.
+
+=cut
+
+sub list_drafts_draft_delete {
+ my ($request) = @_;
+ if (!$request->close_form){
+ list_drafts($request);
+ $request->finalize_request();
+ }
+ my $draft= LedgerSMB::DBObject::Draft->new(base => $request);
+ for my $row (1 .. $draft->{rowcount}){
+ if ($draft->{"draft_" .$draft->{"row_$row"}}){
+ $draft->{id} = $draft->{"row_$row"};
+ $draft->delete;
+ }
+ }
+ search($request);
+}
+
+=item list_drafts
+
+Searches for drafts and lists those matching criteria:
+
+Required hash variables:
+
+type: either 'ar', 'ap', or 'gl'
+
+
+The following inputs are optional and used for filter criteria
+
+with_accno: Draft transaction against a specific account.
+from_date: Earliest date for match
+to_date: Latest date for match
+amount_le: total less than or equal to
+amount_ge: total greater than or equal to
+
+=cut
+
+sub list_drafts {
+ my ($request) = @_;
+ $request->{action} = 'list_drafts';
+ my $draft= LedgerSMB::DBObject::Draft->new(base => $request);
+ $draft->close_form;
+ $draft->open_form({commit => 1});
+ my $callback = 'drafts.pl?action=list_drafts';
+ for (qw(type reference amount_gy amount_lt)){
+ if (defined $draft->{$_}){
+ $callback .= "&$_=$draft->{$_}";
+ }
+ }
+ if ($draft->{order_by}){
+ $draft->set_ordering(
+ {method => 'draft__search',
+ column => $draft->{order_by}}
+ );
+ }
+ my @search_results = $draft->search;
+ $draft->{script} = "drafts.pl";
+ $draft->{callback} = $draft->escape(string => $callback);
+ my @columns =
+ qw(select id transdate reference description amount);
+
+ my $base_href = "drafts.pl";
+ my $search_href = "$base_href?action=list_drafts";
+ my $draft_href= "$base_href?action=get_transaction";
+
+ for my $key (
+ qw(type approved created_by description amount_gt amount_lt)
+ ){
+ $search_href .= "&$key=$draft->{$key}";
+ }
+
+ my $column_names = {
+ 'select' => 'Select',
+ amount => 'AR/AP/GL Total',
+ description => 'Description',
+ id => 'ID',
+ reference => 'Reference',
+ transdate => 'Date'
+ };
+ my $sort_href = "$search_href&order_by";
+ my @sort_columns = qw(id transdate reference description amount);
+
+ my $count = 0;
+ my @rows;
+ for my $result (@search_results){
+ ++$count;
+ $draft->{"row_$count"} = $result->{id};
+ push @rows, {
+ 'select' => {
+ input => {
+ type => 'checkbox',
+ value => 1,
+ name => "draft_$result->{id}"
+ }
+ },
+ amount => $draft->format_amount(
+ amount => $result->{amount}
+ ),
+ reference => {
+ text => $result->{reference},
+ href => "$request->{type}.pl?action=edit&id=$result->{id}" .
+ "&callback=$draft->{callback}",
+ },
+ description => $result->{description},
+ transdate => $result->{transdate},
+ id => $result->{id},
+ };
+ }
+ $draft->{rowcount} = $count;
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'form-dynatable',
+ format => ($draft->{format}) ? $draft->{format} : 'HTML',
+ );
+
+ my $hiddens = $draft->take_top_level();
+ $draft->{rowcount} = "$count";
+ delete $draft->{search_results};
+
+ my $column_heading = $template->column_heading($column_names,
+ {href => $sort_href, columns => ..hidden..
+ );
+
+ $template->render({
+ form => $draft,
+ columns => ..hidden..,
+ heading => $column_heading,
+ rows => ..hidden..,
+ hiddens => $hiddens,
+ buttons => [{
+ name => 'action',
+ type => 'submit',
+ text => $request->{_locale}->text('Post'),
+ value => 'draft_approve',
+ class => 'submit',
+ },{
+ name => 'action',
+ type => 'submit',
+ text => $request->{_locale}->text('Delete'),
+ value => 'draft_delete',
+ class => 'submit',
+ }]
+ });
+}
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 LedgerSMB Core Team. This file is licensed under the GNU
+General Public License version 2, or at your option any later version. Please
+see the included License.txt for details.
+
+=cut
+
+
+1;
Copied: trunk/LedgerSMB/Scripts/employee.pl (from rev 3835, trunk/scripts/employee.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/employee.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/employee.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,426 @@
+#!/usr/bin/perl
+
+=pod
+
+=head1 NAME
+
+LedgerSMB::Scripts::employee - LedgerSMB class defining the Controller
+functions, template instantiation and rendering for employee editing and display.
+
+=head1 SYOPSIS
+
+This module is the UI controller for the employee DB access; it provides the
+View interface, as well as defines the Save employee.
+Save employee will update or create as needed.
+
+
+=head1 METHODS
+
+=over
+
+=cut
+
+package LedgerSMB::Scripts::employee;
+
+use LedgerSMB::Template;
+use LedgerSMB::DBObject::Employee;
+
+#require 'lsmb-request.pl';
+
+=item get($self, $request, $user)
+
+Requires form var: id
+
+Extracts a single employee from the database, using its company ID as the primary
+point of uniqueness. Shows (appropriate to user privileges) and allows editing
+of the employee informations.
+
+=cut
+
+
+sub get {
+
+ my ($request) = @_;
+ my $employee = LedgerSMB::DBObject::Employee->new(base => $request, copy => 'all');
+
+ $employee->get_metadata();
+ $employee->set( entity_class=> '3' );
+ $employee->{target_div} = 'hr_div';
+ my $result = $employee->get();
+
+ my $template = LedgerSMB::Template->new( user => $user,
+ template => 'contact', language => $user->{language},
+ path => 'UI/Contact',
+ format => 'HTML');
+ $template->render($results);
+
+}
+
+=item add_location
+
+Adds a location to an employee and returns to the edit employee screen.
+Standard location inputs apply.
+
+=cut
+
+sub add_location {
+ my ($request) = @_;
+ my $employee= LedgerSMB::DBObject::Employee->new({base => $request, copy => 'all'});
+ $employee->set( entity_class=> '3' );
+ $employee->save_location();
+ $employee->get();
+
+
+
+ _render_main_screen($employee);
+
+}
+
+=item add
+
+This method creates a blank screen for entering a employee's information.
+
+=cut
+
+sub add {
+ my ($request) = @_;
+ my $employee= LedgerSMB::DBObject::Employee->new(base => $request, copy => 'all');
+ $employee->set( entity_class=> '3' );
+ $employee->{target_div} = 'hr_div';
+ _render_main_screen($employee);
+}
+
+=item delete_contact
+
+Deletes the selected contact info record
+
+Must include company_id or credit_id (credit_id used if both are provided) plus:
+
+=over
+
+=item contact_class_id
+
+=item contact
+
+=item form_id
+
+=back
+
+=cut
+
+sub delete_contact {
+ my ($request) = @_;
+ my $employee= LedgerSMB::DBObject::Employee->new(base => $request, copy => 'all');
+ if (_close_form($employee)){
+ $employee->delete_contact();
+ }
+ $employee->get;
+ _render_main_screen( $employee);
+}
+
+=item save_contact_new($request)
+
+Saves contact info as a new line as per save_contact above.
+
+=cut
+
+sub save_contact_new{
+ my ($request) = @_;
+ delete $request->{old_contact};
+ delete $request->{old_contact_class};
+ save_contact($request);
+}
+
+=item delete_location
+
+Deletes the selected contact info record
+
+Must include company_id or credit_id (credit_id used if both are provided) plus:
+
+* location_class_id
+* location_id
+* form_id
+
+=cut
+
+sub delete_location {
+ my ($request) = @_;
+ my $employee= LedgerSMB::DBObject::Employee->new(base => $request, copy => 'all');
+ if (_close_form($employee)){
+ $employee->delete_location();
+ }
+ $employee->get;
+ _render_main_screen( $employee);
+}
+
+=item edit_bank_account($request)
+
+displays screen to a bank account
+
+Required data:
+
+=over
+
+=item bank_account_id
+
+=item bic
+
+=item iban
+
+=back
+
+=cut
+
+sub edit_bank_acct {
+ my ($request) = @_;
+ my $employee= LedgerSMB::DBObject::Employee->new(base => $request, copy => 'all');
+ $employee->get;
+ _render_main_screen( $employee);
+}
+
+=item delete_bank_acct
+
+Deletes the selected bank account record
+
+Required request variables:
+
+=over
+
+=item bank_account_id
+
+=item entity_id
+
+=item form_id
+
+=back
+
+=cut
+
+sub delete_bank_acct{
+ my ($request) = @_;
+ my $employee= LedgerSMB::DBObject::Employee->new(base => $request, copy => 'all');
+ if (_close_form($employee)){
+ $employee->delete_bank_account();
+ }
+ $employee->get;
+ _render_main_screen( $employee);
+}
+
+# Private method. Sets notice if form could not be closed.
+sub _close_form {
+ my ($employee) = @_;
+ if (!$employee->close_form()){
+ $employee->{notice} =
+ $employee->{_locale}->text('Changes not saved. Please try again.');
+ return 0;
+ }
+ return 1;
+}
+
+=item save($self, $request, $user)
+
+Saves a employee to the database. The function will update or insert a new
+employee as needed, and will generate a new Company ID for the employee if needed.
+
+=cut
+
+sub save {
+
+ my ($request) = @_;
+
+ my $employee = LedgerSMB::DBObject::Employee->new({base => $request});
+ if (!$employee->{employeenumber}){
+ my ($ref) = $employee->call_procedure(
+ procname => 'setting_increment',
+ args => ['employeenumber']
+ );
+ ($employee->{employee_number}) = values %$ref;
+ }
+ $employee->save();
+ _render_main_screen($employee);
+}
+
+=item search
+
+Displays the search criteria screen
+
+=cut
+
+sub search {
+ my $request = shift @_;
+ my $template = LedgerSMB::Template->new(
+ user => $employee->{_user},
+ template => 'filter',
+ locale => $employee->{_locale},
+ path => 'UI/employee',
+ format => 'HTML'
+ );
+ $template->render($request);
+}
+
+=item search_results
+
+Displays search results.
+
+=cut
+
+sub search_results {
+ my $request = shift @_;
+ my $employee = LedgerSMB::DBObject::Employee->new({base => $request});
+ my @rows = $employee->search();
+ my $template = LedgerSMB::Template->new(
+ user => $employee->{_user},
+ template => 'form-dynatable',
+ locale => $employee->{_locale},
+ path => 'UI',
+ format => 'HTML'
+ );
+ my @columns;
+ my $locale = $request->{_locale};
+ $request->{title} = $locale->text('Search Results');
+ for my $col (qw(l_position l_id l_employeenumber l_salutation
+ l_first_name l_middle_name l_last_name l_dob
+ l_startdate l_enddate l_role l_ssn l_sales l_manager_id
+ l_manager_first_name l_manager_last_name)){
+ if ($request->{$col}){
+ my $pcol = $col;
+ $pcol =~ s/^l_//;
+ push @columns, $pcol;
+ }
+ }
+ # Omitting headers for the running number and salutation fields --CT
+ my $header = {
+ id => $locale->text('ID'),
+employeenumber=> $locale->text('Employee Number'),
+ first_name => $locale->text('First Name'),
+ middle_name => $locale->text('Middle Name'),
+ last_name => $locale->text('Last Name'),
+ dob => $locale->text('DOB'),
+ startdate => $locale->text('Start Date'),
+ enddate => $locale->text('End Date'),
+ role => $locale->text('Role'),
+ ssn => $locale->text('SSN'),
+ sales => $locale->text('Sales'),
+ manager_id => $locale->text('Manager ID'),
+
+
+ manager_first_name => $locale->text('Manager First Name'),
+ manager_last_name => $locale->text('Manager Last Name'),
+ };
+
+ my $pos = 1;
+ for my $ref(@rows){
+ $ref->{position} = $pos;
+ my $href = "employee.pl?action=edit&entity_id=$ref->{entity_id}";
+ $ref->{id} = {href => $href,
+ text => $ref->{entity_id}};
+ $ref->{employeenumber} = { href => $href,
+ text => $ref->{employeenumber} };
+ ++$pos;
+ }
+ $template->render({
+ form => $request,
+ columns => ..hidden..,
+ heading => $header,
+ rows => ..hidden..,
+ });
+}
+
+=item edit
+
+displays the edit employee screen. Requires id field to be set.
+
+=cut
+
+sub edit{
+ my $request = shift @_;
+ my $employee = LedgerSMB::DBObject::Employee->new({base => $request});
+ $employee->get();
+ _render_main_screen($employee);
+}
+
+sub _render_main_screen{
+ my $employee = shift @_;
+ $employee->get_metadata();
+ $employee->close_form;
+ $employee->open_form;
+ $employee->{dbh}->commit;
+ $employee->{entity_class} = 3;
+ $employee->{creditlimit} = "$employee->{creditlimit}";
+ $employee->{discount} = "$employee->{discount}";
+ $employee->{script} = "employee.pl";
+ if ($employee->is_allowed_role({allowed_roles => [
+ "lsmb_$employee->{company}__users_manage"]
+ }
+ )){
+ $employee->{manage_users} = 1;
+ }
+ $employee->debug({file => '/tmp/emp'});
+ my $template = LedgerSMB::Template->new(
+ user => $employee->{_user},
+ template => 'contact',
+ locale => $employee->{_locale},
+ path => 'UI/Contact',
+ format => 'HTML'
+ );
+ $template->render($employee);
+}
+
+=item save_contact
+
+Saves contact info and returns to edit employee screen
+
+=cut
+
+sub save_contact {
+ my ($request) = @_;
+ my $employee = LedgerSMB::DBObject::Employee->new({base => $request});
+ $employee->save_contact();
+ $employee->get;
+ _render_main_screen($employee );
+}
+
+=item save_bank_account
+
+Saves bank account information (bic, iban, id required) and returns to the
+edit employee screen
+
+=cut
+
+sub save_bank_account {
+ my ($request) = @_;
+ my $employee = LedgerSMB::DBObject::Employee->new({base => $request});
+ $employee->save_bank_account();
+ $employee->get;
+ _render_main_screen($employee);
+}
+
+=item save_notes
+
+Attaches note (subject, note, id required) and returns to the edit employee
+screen.
+
+=cut
+
+sub save_notes {
+ my ($request) = @_;
+ my $employee = LedgerSMB::DBObject::Employee->new({base => $request});
+ $employee->save_notes();
+ $employee->get();
+ _render_main_screen($employee);
+}
+
+eval { do "scripts/custom/employee.pl"};
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 LedgerSMB Core Team. This file is licensed under the GNU
+General Public License version 2, or at your option any later version. Please
+see the included License.txt for details.
+
+=cut
+
+
+1;
Copied: trunk/LedgerSMB/Scripts/file.pl (from rev 3835, trunk/scripts/file.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/file.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/file.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,121 @@
+=pod
+
+=head1 NAME
+
+LedgerSMB::Scripts::file
+
+=head1 SYNOPSIS
+
+This supplies file retrival and attachment workflows
+
+=head1 METHODS
+
+=over
+
+=item get
+
+Retrieves a file and sends it to the web browser.
+
+Requires that id and file_class be set.
+
+=cut
+
+package LedgerSMB::Scripts::file;
+use LedgerSMB::File;
+use LedgerSMB::File::Transaction;
+use LedgerSMB::File::Order;
+use LedgerSMB::File::Part;
+use strict;
+use CGI::Simple;
+
+our $fileclassmap = {
+ 1 => 'LedgerSMB::File::Transaction',
+ 2 => 'LedgerSMB::File::Order',
+ 3 => 'LedgerSMB::File::Part',
+};
+
+sub get {
+ my ($request) = @_;
+ my $file = LedgerSMB::File->new();
+ $file->dbobject(LedgerSMB::DBObject->new({base => $request}));
+ $file->id($request->{id});
+ $file->file_class($request->{file_class});
+ $file->get();
+
+ my $cgi = CGI::Simple->new();
+
+ print $cgi->header(
+ -type => $file->get_mime_type,
+ -status => '200',
+ -charset => 'utf-8',
+ -attachment => $file->file_name,
+ );
+ print $file->content;
+}
+
+=item show_attachment_screen
+
+Show the attachment or upload screen.
+
+=cut
+
+sub show_attachment_screen {
+ my ($request) = @_;
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/file',
+ template => 'attachment_screen',
+ format => 'HTML'
+ );
+ $template->render($request);
+}
+
+=item attach_file
+
+Attaches a file to an object
+
+=cut
+
+sub attach_file {
+ my ($request) = @_;
+ my $file = $fileclassmap->{$request->{file_class}}->new();
+ $file->dbobject(LedgerSMB::DBObject->new({base => $request}));
+ my @fnames = $request->{_request}->upload_info;
+ $file->file_name($fnames[0]);
+ $file->merge($request);
+ if ($request->{url}){
+ $file->mime_type_text('text/x-uri');
+ $file->content($request->{url});
+ } else {
+ use File::MimeInfo;
+ $file->file_name($fnames[0]);
+ if (!$file->file_name){
+ $request->error($request->{_locale}->text(
+ 'No file uploaded'
+ ));
+ }
+ $file->get_mime_type;
+ my $fh = $request->{_request}->upload('upload_data');
+ my $fdata = join ("", <$fh>);
+ $file->content($fdata);
+ }
+ $request->{content} = $file->content;
+ $request->debug({file => '/tmp/file'});
+ $file->attach;
+ my $cgi = CGI::Simple->new;
+ print $cgi->redirect($request->{callback});
+}
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2011 LedgerSMB Core Team. This file is licensed under the GNU
+General Public License version 2, or at your option any later version. Please
+see the included License.txt for details.
+
+=cut
+
+
+1;
Copied: trunk/LedgerSMB/Scripts/inventory.pl (from rev 3835, trunk/scripts/inventory.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/inventory.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/inventory.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,118 @@
+=pod
+
+=head1 NAME
+
+LedgerSMB::Scripts::inventory - LedgerSMB class defining the Controller
+functions, template instantiation and rendering for inventory management.
+
+=head1 SYOPSIS
+
+This module is the UI controller for the customer DB access; it provides the
+View interface, as well as defines the Save customer.
+Save customer will update or create as needed.
+
+
+=head1 METHODS
+
+=cut
+package LedgerSMB::Scripts::customer;
+
+use LedgerSMB::Template;
+use LedgerSMB::DBObject::Customer;
+
+#require 'lsmb-request.pl';
+
+=over
+
+=item begin_adjust
+
+This entry point specifies the screen for setting up an inventory adjustment.
+
+=back
+
+=cut
+
+sub begin_adjust {
+ my ($request) = @_;
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ template => 'adjustment_setup',
+ locale => $request->{_locale},
+ path => 'UI/inventory',
+ format => 'HTML'
+ );
+ $template->render($request);
+}
+
+=over
+
+=item enter_adjust
+
+This entry point specifies the screen for entering an inventory adjustment.
+
+=back
+
+=cut
+
+sub enter_adjust {
+ my ($request) = @_;
+ my $adjustment = LedgerSMB::DBObject::Inventory->new(base => $request);
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ template => 'adjustment_entry',
+ locale => $request->{_locale},
+ path => 'UI/inventory',
+ format => 'HTML'
+ );
+ $template->render($adjustment);
+}
+
+
+=over
+
+=item adjustment_next
+
+This function is triggered on the next button on the adjustment entry screen.
+It retrieves inventory information, calculates adjustment values, and displays the
+screen.
+
+=back
+
+=cut
+
+sub adjustment_next {
+ my ($request) = @_;
+ my $adjustment = LedgerSMB::DBObject::Inventory->new(base => $request);
+ for my $i (1 .. $adjustment->{rowcount}){
+ if ($adjustment->{"row_$i"} eq "new"){
+ my $item = $adjustment->retrieve_item_at_date(
+ $adjustment->{"partnumber_new_$i"});
+ $adjustment->{"row_$i"} = $item->{id};
+ $adjustment->{"description_$i"} = $item->{description};
+ $adjustment->{"onhand_$i"} = $item->{onhand};
+ }
+ $adjustment->{"qty_$i"} = $adjustment->{"onhand_$i"}
+ - $adjustment->{"counted_$i"};
+ }
+ ++$adjustment->{rowcount};
+ enter_adjust($adjustment);
+}
+
+=over
+
+=item adjustment_save
+
+This function saves the inventory adjustment report and then creates the required
+invoices.
+
+=back
+
+=cut
+
+sub adjustment_save {
+ my ($request) = @_;
+ my $adjustment = LedgerSMB::DBObject::Inventory->new(base => $request);
+ $adjustment->save;
+ begin_adjust($request);
+}
+1;
Copied: trunk/LedgerSMB/Scripts/journal.pl (from rev 3835, trunk/scripts/journal.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/journal.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/journal.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,76 @@
+#!/usr/bin/perl
+
+
+=head1 NAME
+
+LedgerSMB::Scripts::journal - LedgerSMB slim ajax script for journal's
+account search request.
+
+=head1 SYNOPSIS
+
+A script for journal ajax requests: accepts a search string and returns a
+list of matching accounts in a ul/li pair acceptable for scriptaculous's
+autocomplete library..
+
+=head1 METHODS
+
+=cut
+
+package LedgerSMB::Scripts::journal;
+our $VERSION = '1.0';
+
+use LedgerSMB;
+use LedgerSMB::Template;
+use strict;
+
+=pod
+
+=over
+
+=item __default
+
+Get the search string, query the database, return the results in a ul/li
+pair easily queried by scriptaculous's autocompleter.
+
+=back
+
+=cut
+
+sub __default {
+ my ($request) = @_;
+ my $template;
+ my %hits = ();
+
+ $template = LedgerSMB::Template->new(
+ path => 'UI',
+ template => 'ajax_li',
+ format => 'HTML',
+ );
+
+ my $funcname = 'chart_list_search';
+ my %results_hash;
+ foreach my $r (keys %{$request})
+ {
+
+ if ($r =~ m/-ac-search$/)
+ {
+ my @call_args = ($request->{$r}, $request->{link_desc});
+ my @results = $request->call_procedure( procname => $funcname, args => ..hidden.., order_by => 'accno' );
+ foreach (@results) { $results_hash{$_->{'accno'}.'--'.$_->{'description'}} = $_->{'accno'}.'--'.$_->{'description'}; }
+ }
+ }
+
+ $request->{results} = \%results_hash;
+ $template->render($request);
+}
+
+=head1 Copyright (C) 2007 The LedgerSMB Core Team
+
+Licensed under the GNU General Public License version 2 or later (at your
+option). For more information please see the included LICENSE and COPYRIGHT
+files.
+
+=cut
+
+eval { do "scripts/custom/journal.pl"};
+1;
Copied: trunk/LedgerSMB/Scripts/login.pl (from rev 3835, trunk/scripts/login.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/login.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/login.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,166 @@
+
+=pod
+
+=head1 NAME
+
+LedgerSMB:Scripts::login, LedgerSMB workflow scripts for managing drafts
+
+=head1 SYNOPSIS
+
+This script contains the request handlers for logging in and out of LedgerSMB.
+
+=head1 METHODS
+
+=over
+
+=cut
+
+
+package LedgerSMB::Scripts::login;
+our $VERSION = 1.0;
+
+use LedgerSMB::Locale;
+use LedgerSMB;
+use LedgerSMB::User;
+use LedgerSMB::Auth;
+use LedgerSMB::Sysconfig;
+use strict;
+
+=item __default (no action specified, do this)
+
+Displays the login screen.
+
+=cut
+
+sub __default {
+ my ($request) = @_;
+ my $locale;
+ $locale = LedgerSMB::Locale->get_handle(${LedgerSMB::Sysconfig::language})
+ or $request->error( __FILE__ . ':' . __LINE__ .
+ ": Locale not loaded: $!\n" );
+
+ $request->{stylesheet} = "ledgersmb.css";
+ $request->{titlebar} = "LedgerSMB $request->{VERSION}";
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $locale,
+ path => 'UI',
+ template => 'login',
+ format => 'HTML'
+ );
+ $template->render($request);
+}
+
+=item authenticate
+
+This routine checks for the authentication information and if successful
+sends either a 302 redirect or a 200 successful response.
+
+If unsuccessful sends a 401 if the username/password is bad, or a 454 error
+if the database does not exist.
+
+=cut
+
+sub authenticate {
+ my ($request) = @_;
+ if (!$request->{dbh}){
+ if (!$request->{company}){
+ $request->{company} = $LedgerSMB::Sysconfig::default_db;
+ }
+ $request->_db_init;
+ }
+ my $path = $ENV{SCRIPT_NAME};
+ $path =~ s|[^/]*$||;
+
+ if ($request->{dbh} && $request->{next}) {
+
+ print "Content-Type: text/html\n";
+ print "Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=Login; path=$path\n";
+ print "Status: 302 Found\n";
+ print "Location: ".$path.$request->{next}."\n";
+ print "\n";
+ $request->finalize_request();
+ }
+ elsif ($request->{dbh} and !$request->{log_out}){
+ print "Content-Type: text/html\n";
+ print "Set-Cookie: ${LedgerSMB::Sysconfig::cookie_name}=Login; path=$path\n";
+ print "Status: 200 Success\n\n";
+ if ($request->{log_out}){
+ $request->finalize_request();
+ }
+ }
+ else {
+ if ($request->{_auth_error} =~/$LedgerSMB::Sysconfig::no_db_str/i){
+ print "Status: 454 Database Does Not Exist\n\n";
+ print "No message here";
+ } else {
+ print "WWW-Authenticate: Basic realm=\"LedgerSMB\"\n";
+ print "Status: 401 Unauthorized\n\n";
+ print "Please enter your credentials.\n";
+ }
+ $request->finalize_request();
+ }
+}
+
+=item login
+
+Logs in the user and displays the root document.
+
+=cut
+
+sub login {
+ my ($request) = @_;
+
+ if (!$request->{_user}){
+ __default($request);
+ }
+ require "scripts/menu.pl";
+ LedgerSMB::Scripts::menu::root_doc($request);
+
+}
+
+=item logout
+
+Logs the user out. Handling of HTTP browser credentials is browser-specific.
+
+Firefox, Opera, and Internet Explorer are all supported. Not sure about Chrome
+
+=cut
+
+sub logout {
+ my ($request) = @_;
+ @{$request->{scripts}} =
+ qw(UI/logout/iexplore.js
+ UI/logout/firefox.js
+ UI/logout/opera.js
+ UI/logout/safari.js
+ UI/logout/konqueror.js
+ UI/logout/epiphany.js
+ );
+ $request->{callback} = "";
+ $request->{endsession} = 1;
+ LedgerSMB::Auth::session_destroy($request);
+ my $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'logout',
+ format => 'HTML'
+ );
+ $template->render($request);
+}
+
+eval { do "scripts/custom/login.pl"};
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 LedgerSMB Core Team. This file is licensed under the GNU
+General Public License version 2, or at your option any later version. Please
+see the included License.txt for details.
+
+=cut
+
+
+1;
Copied: trunk/LedgerSMB/Scripts/menu.pl (from rev 3835, trunk/scripts/menu.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/menu.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/menu.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,182 @@
+#!/usr/bin/perl
+
+
+=head1 NAME
+
+LedgerSMB::Scripts::menu - LedgerSMB controller script for menus
+
+=head1 SYOPSIS
+
+This script provides a controller class for generating menus. It can operate in
+two modes: One creates a standard expanding menu which works with or without
+javascript. The second creates drilldown menus for small-screen or text-only
+devices.
+
+=head1 METHODS
+
+=cut
+
+package LedgerSMB::Scripts::menu;
+our $VERSION = '1.0';
+
+use LedgerSMB::DBObject::Menu;
+use LedgerSMB::Template;
+use strict;
+
+
+=pod
+
+=over
+
+=item __default
+
+This pseudomethod is used to trap menu clicks that come back through the file
+and route to the appropriate function. If $request->{menubar} is set, it routes
+to the drilldown_menu. Otherwise, it routes to expanding_menu.
+
+=back
+
+=cut
+
+sub __default {
+ my ($request) = @_;
+ if ($request->{new}){
+ root_doc($request);
+ }
+ if ($request->{menubar}){
+ drilldown_menu($request);
+ } else {
+ expanding_menu($request);
+ }
+}
+
+=pod
+
+=over
+
+=item root_doc
+
+If $request->{menubar} is set, this creates a drilldown menu. Otherwise, it
+creates the root document (currently a frameset).
+
+=back
+
+
+=cut
+
+sub root_doc {
+ my ($request) = @_;
+ my $template;
+
+ $request->{title} = "LedgerSMB $request->{VERSION} -- ".
+ "$request->{login} -- $request->{company}";
+
+ if ($request->{menubar}){
+ drilldown_menu($request);
+ return;
+ } else {
+ my $userpw = LedgerSMB::DBObject::Menu->new({base => $request});
+ if ($userpw->will_expire_soon){
+ $request->{main} = 'user.pl?action=preference_screen';
+ } else {
+ $request->{main} = "am.pl?action=recurring_transactions"
+ if $request->{main} eq 'recurring_transactions';
+ }
+ $template = LedgerSMB::Template->new(
+ user =>$request->{_user},
+ locale => $request->{_locale},
+ path => 'UI',
+ template => 'frameset',
+ format => 'HTML'
+ );
+ }
+ $template->render($request);
+}
+
+=pod
+
+=over
+
+=item expanding_menu
+
+This function generates an expanding menu. By default all nodes are closed, but
+there nodes which are supposed to be open are marked.
+
+
+=back
+
+=cut
+
+sub expanding_menu {
+ my ($request) = @_;
+ if ($request->{'open'} !~ s/:$request->{id}:/:/){
+ $request->{'open'} .= ":$request->{id}:";
+ }
+
+ # The above system can lead to extra colons.
+ $request->{'open'} =~ s/:+/:/g;
+
+
+ my $menu = LedgerSMB::DBObject::Menu->new({base => $request});
+ $menu->generate();
+ for my $item (@{$menu->{menu_items}}){
+ if ($request->{'open'} =~ /:$item->{id}:/ ){
+ $item->{'open'} = 'true';
+ }
+ }
+
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/menu',
+ template => 'expanding',
+ format => 'HTML',
+ );
+ $template->render($menu);
+}
+
+=pod
+
+=over
+
+=item drillown_menu
+
+This function creates a single cross section of the menu. Currently this is
+most useful for generating menus for small screen devices or devices where a
+limited number of options are necessary (screen readers, text-only browsers and
+the like).
+
+=back
+
+=cut
+
+sub drilldown_menu {
+ my ($request) = @_;
+ my $menu = LedgerSMB::DBObject::Menu->new({base => $request});
+
+ $menu->{parent_id} ||= 0;
+
+ print STDERR "Testing";
+ $menu->generate_section;
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/menu',
+ template => 'drilldown',
+ format => 'HTML',
+ );
+ $template->render($menu);
+}
+
+=pod
+
+=head1 Copyright (C) 2007 The LedgerSMB Core Team
+
+Licensed under the GNU General Public License version 2 or later (at your
+option). For more information please see the included LICENSE and COPYRIGHT
+files.
+
+=cut
+
+eval { do "scripts/custom/menu.pl"};
+1;
Copied: trunk/LedgerSMB/Scripts/payment.pl (from rev 3835, trunk/scripts/payment.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/payment.pl (rev 0)
+++ trunk/LedgerSMB/Scripts/payment.pl 2011-10-11 23:36:58 UTC (rev 3836)
@@ -0,0 +1,1960 @@
+=pod
+
+=head1 NAME
+
+LedgerSMB::Scripts::payment - LedgerSMB class defining the Controller functions for payment handling.
+
+=head1 SYNOPSIS
+
+Defines the controller functions and workflow logic for payment processing.
+
+=head1 COPYRIGHT
+
+Portions Copyright (c) 2007, David Mora R and Christian Ceballos B.
+
+Licensed to the public under the terms of the GNU GPL version 2 or later.
+
+Original copyright notice below.
+
+#=====================================================================
+# PLAXIS
+# Copyright (c) 2007
+#
+# Author: David Mora R
+# Christian Ceballos B
+#
+#
+#
+#
+#
+# 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.
+
+
+=head1 METHODS
+
+=cut
+
+
+package LedgerSMB::Scripts::payment;
+use LedgerSMB::Template;
+use LedgerSMB::Sysconfig;
+use LedgerSMB::DBObject::Payment;
+use LedgerSMB::DBObject::Date;
+use LedgerSMB::CancelFurtherProcessing;
+use Error::Simple;
+use Error;
+use strict;
+
+# CT: A few notes for future refactoring of this code:
+# 1: I don't think it is a good idea to make the UI too dependant on internal
+# code structures but I don't see a good alternative at the moment.
+# 2: CamelCasing: -1
+# 3: Not good to have this much duplication of code all the way down the stack.# At the moment this is helpful because it gives us an opportunity to look
+# at various sets of requirements and workflows, but for future versions
+# if we don't refactor, this will turn into a bug factory.
+# 4: Both current interfaces have issues regarding separating layers of logic
+# and concern properly.
+
+# CT: Plans are to completely rewrite all payment logic for 1.4 anyway.
+
+=pod
+
+=item payment
+
+This method is used to set the filter screen and prints it, using the
+TT2 system.
+
+=back
+
+=cut
+
+sub payments {
+ my ($request) = @_;
+ my $payment = LedgerSMB::DBObject::Payment->new({'base' => $request});
+ $payment->get_metadata();
+ if (!defined $payment->{batch_date}){
+ $payment->error("No Batch Date!");
+ }
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/payments',
+ template => 'payments_filter',
+ format => 'HTML',
+ );
+ $template->render($payment);
+}
+
+=item get_search_criteria
+
+Displays the payment criteria screen. Optional inputs are
+
+=over
+
+=item batch_id
+
+=item batch_date
+
+=back
+
+=cut
+
+sub get_search_criteria {
+ my ($request) = @_;
+ my $payment = LedgerSMB::DBObject::Payment->new({'base' => $request});
+ $payment->get_metadata();
+ if ($payment->{batch_id} && $payment->{batch_date}){
+ $payment->{date_reversed} = $payment->{batch_date};
+ }
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ locale => $request->{_locale},
+ path => 'UI/payments',
+ template => 'search',
+ format => 'HTML',
+ );
+ $template->render($payment);
+}
+
+=item pre_bulk_post_report
+
+This displays a report of the expected GL activity of a payment batch before it
+is saved. For receipts, this just redirects to bulk_post currently.
+
+=cut
+
+sub pre_bulk_post_report {
+ my ($request) = @_;
+ if ($request->{account_class} == 2){ # Not so helpful for receipts --CT
+ post_payments_bulk($request);
+ }
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
@@ Diff output truncated at 100000 characters. @@
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.