[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb:[3838] trunk/LedgerSMB/Scripts
- Subject: SF.net SVN: ledger-smb:[3838] trunk/LedgerSMB/Scripts
- From: ..hidden..
- Date: Wed, 12 Oct 2011 00:11:40 +0000
Revision: 3838
http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=3838&view=rev
Author: einhverfr
Date: 2011-10-12 00:11:39 +0000 (Wed, 12 Oct 2011)
Log Message:
-----------
File relocation complete
Added Paths:
-----------
trunk/LedgerSMB/Scripts/account.pm
trunk/LedgerSMB/Scripts/admin.pm
trunk/LedgerSMB/Scripts/asset.pm
trunk/LedgerSMB/Scripts/customer.pm
trunk/LedgerSMB/Scripts/drafts.pm
trunk/LedgerSMB/Scripts/employee.pm
trunk/LedgerSMB/Scripts/file.pm
trunk/LedgerSMB/Scripts/inventory.pm
trunk/LedgerSMB/Scripts/journal.pm
trunk/LedgerSMB/Scripts/login.pm
trunk/LedgerSMB/Scripts/menu.pm
trunk/LedgerSMB/Scripts/payment.pm
trunk/LedgerSMB/Scripts/recon.pm
trunk/LedgerSMB/Scripts/setup.pm
trunk/LedgerSMB/Scripts/taxform.pm
trunk/LedgerSMB/Scripts/user.pm
trunk/LedgerSMB/Scripts/vendor.pm
trunk/LedgerSMB/Scripts/vouchers.pm
Removed Paths:
-------------
trunk/LedgerSMB/Scripts/account.pl
trunk/LedgerSMB/Scripts/admin.pl
trunk/LedgerSMB/Scripts/asset.pl
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
Deleted: trunk/LedgerSMB/Scripts/account.pl
===================================================================
--- trunk/LedgerSMB/Scripts/account.pl 2011-10-11 23:52:25 UTC (rev 3837)
+++ trunk/LedgerSMB/Scripts/account.pl 2011-10-12 00:11:39 UTC (rev 3838)
@@ -1,228 +0,0 @@
-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/account.pm (from rev 3836, trunk/LedgerSMB/Scripts/account.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/account.pm (rev 0)
+++ trunk/LedgerSMB/Scripts/account.pm 2011-10-12 00:11:39 UTC (rev 3838)
@@ -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;
Deleted: trunk/LedgerSMB/Scripts/admin.pl
===================================================================
--- trunk/LedgerSMB/Scripts/admin.pl 2011-10-11 23:52:25 UTC (rev 3837)
+++ trunk/LedgerSMB/Scripts/admin.pl 2011-10-12 00:11:39 UTC (rev 3838)
@@ -1,448 +0,0 @@
-#!/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/admin.pm (from rev 3836, trunk/LedgerSMB/Scripts/admin.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/admin.pm (rev 0)
+++ trunk/LedgerSMB/Scripts/admin.pm 2011-10-12 00:11:39 UTC (rev 3838)
@@ -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;
Deleted: trunk/LedgerSMB/Scripts/asset.pl
===================================================================
--- trunk/LedgerSMB/Scripts/asset.pl 2011-10-11 23:52:25 UTC (rev 3837)
+++ trunk/LedgerSMB/Scripts/asset.pl 2011-10-12 00:11:39 UTC (rev 3838)
@@ -1,1181 +0,0 @@
-=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/asset.pm (from rev 3836, trunk/LedgerSMB/Scripts/asset.pl)
===================================================================
--- trunk/LedgerSMB/Scripts/asset.pm (rev 0)
+++ trunk/LedgerSMB/Scripts/asset.pm 2011-10-12 00:11:39 UTC (rev 3838)
@@ -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
@@ Diff output truncated at 100000 characters. @@
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.