[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb:[4963] addons/1.3
- Subject: SF.net SVN: ledger-smb:[4963] addons/1.3
- From: ..hidden..
- Date: Tue, 10 Jul 2012 09:15:05 +0000
Revision: 4963
http://ledger-smb.svn.sourceforge.net/ledger-smb/?rev=4963&view=rev
Author: einhverfr
Date: 2012-07-10 09:15:05 +0000 (Tue, 10 Jul 2012)
Log Message:
-----------
Backport of Customer/Cendor/Lead tracking for 1.3
Added Paths:
-----------
addons/1.3/crm-basic/
addons/1.3/crm-basic/trunk/
addons/1.3/crm-basic/trunk/LedgerSMB/
addons/1.3/crm-basic/trunk/LedgerSMB/DBObject/
addons/1.3/crm-basic/trunk/LedgerSMB/DBObject/Entity/
addons/1.3/crm-basic/trunk/LedgerSMB/DBObject/Entity.pm
addons/1.3/crm-basic/trunk/scripts/
addons/1.3/crm-basic/trunk/scripts/contact.pl
Copied: addons/1.3/crm-basic/trunk/LedgerSMB/DBObject/Entity.pm (from rev 4961, trunk/LedgerSMB/DBObject/Entity.pm)
===================================================================
--- addons/1.3/crm-basic/trunk/LedgerSMB/DBObject/Entity.pm (rev 0)
+++ addons/1.3/crm-basic/trunk/LedgerSMB/DBObject/Entity.pm 2012-07-10 09:15:05 UTC (rev 4963)
@@ -0,0 +1,98 @@
+=head1 NAME
+
+LedgerSMB::DBObject::Entity -- Entity Management base classes for LedgerSMB
+
+=cut
+
+package LedgerSMB::DBObject::Entity;
+use Moose;
+extends 'LedgerSMB::DBObject_Moose';
+
+=head1 SYNOPSYS
+
+This module anages basic entity management for persons and companies, both of which will
+likely inherit this class.
+
+=head1 INHERITS
+
+=over
+
+=item LedgerSMB::DBObject_Moose
+
+=back
+
+=cut
+
+
+=head1 PROPERTIES
+
+=over
+
+=item id
+
+This is the internal, system id, which is a surrogate key. This will be undefined when
+the entity has not yet been saved to the database and set once it has been saved or
+retrieved.
+
+=cut
+
+has 'id' => (is => 'rw', isa => 'Maybe[Str]', required => '0');
+
+=item control_code
+
+The control code is the internal handling number for the operator to use to pull up
+an entity,
+
+=cut
+
+has 'control_code' => (is => 'rw', isa => 'Str', required => 1);
+
+=item name
+
+The unofficial name of the entity. This is usually copied in from company.legal_name
+or prepared (using some sort of locale-specific logic) from person.first_name and
+person.last_name.
+
+=cut
+
+has 'name' => (is => 'rw', isa => 'Maybe[Str]');
+
+=item country_id
+
+ID of country of entiy.
+
+=cut
+
+has 'country_id' => (is => 'rw', isa => 'Int');
+
+=item country_name
+
+Name of country (optional)
+
+=cut
+
+has 'country_name' => (is => 'rw', isa => 'Maybe[Str]');
+
+=item entity_class
+
+Primary class of entity. This is mostly for reporting purposes. See entity_class
+table in database for list of valid values, but 1 is for vendors, 2 for customers,
+3 for employees, etc.
+
+=back
+
+=cut
+
+has 'entity_class' => (is => 'rw', isa => 'Int');
+
+=head1 COPYRIGHT
+
+Copyright (C) 2012 The LedgerSMB Core Team. This file may be reused under the
+conditions of the GNU GPL v2 or at your option any later version. Please see the
+accompanying LICENSE.TXT for more information.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
+
+return 1;
Copied: addons/1.3/crm-basic/trunk/scripts/contact.pl (from rev 4961, trunk/LedgerSMB/Scripts/contact.pm)
===================================================================
--- addons/1.3/crm-basic/trunk/scripts/contact.pl (rev 0)
+++ addons/1.3/crm-basic/trunk/scripts/contact.pl 2012-07-10 09:15:05 UTC (rev 4963)
@@ -0,0 +1,698 @@
+
+=pod
+
+=head1 NAME
+
+LedgerSMB::Scripts::contact - 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, vendor, etc functions; it
+
+=head1 METHODS
+
+=cut
+
+package LedgerSMB::Scripts::contact;
+
+use LedgerSMB::DBObject::Entity::Company;
+use LedgerSMB::DBObject::Entity::Person;
+use LedgerSMB::DBObject::Entity::Credit_Account;
+use LedgerSMB::DBObject::Entity::Location;
+use LedgerSMB::DBObject::Entity::Contact;
+use LedgerSMB::DBObject::Entity::Bank;
+use LedgerSMB::DBObject::Entity::Note;
+use LedgerSMB::File;
+use LedgerSMB::App_State;
+use LedgerSMB::Template;
+
+use strict;
+use warnings;
+
+my $locale = $LedgerSMB::App_State::Locale;
+
+=head1 COPYRIGHT
+
+Copyright (c) 2012, 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
+
+=head1 METHODS
+
+=over
+
+=item get_by_cc
+
+Populates the company area with info on the company, pulled up through the
+control code
+
+=cut
+
+sub get_by_cc {
+ my ($request) = @_;
+ my $entity =
+ LedgerSMB::DBObject::Entity::Company->get_by_cc($request->{control_code});
+ $entity ||= LedgerSMB::DBObject::Entity::Person->get_by_cc($request->{control_code});
+ my ($company, $person) = (undef, undef);
+ if ($entity->isa('LedgerSMB::DBObject::Entity::Company')){
+ $company = $entity;
+ } elsif ($entity->isa('LedgerSMB::DBObject::Entity::Person')){
+ $person = $entity;
+ }
+ _main_screen($request, $company, $person);
+}
+
+
+=item get($self, $request, $user)
+
+Requires form var: id
+
+Extracts a single company from the database, using its company ID as the primary
+point of uniqueness. Shows (appropriate to user privileges) and allows editing
+of the company information.
+
+=cut
+
+sub get {
+ my ($request) = @_;
+ my $entity = LedgerSMB::DBObject::Entity::Company->get($request->{entity_id});
+ $entity ||= LedgerSMB::DBObject::Entity::Person->get($request->{entity_id});
+ my ($company, $person) = (undef, undef);
+ if ($entity->isa('LedgerSMB::DBObject::Entity::Company')){
+ $company = $entity;
+ } elsif ($entity->isa('LedgerSMB::DBObject::Entity::Person')){
+ $person = $entity;
+ }
+ _main_screen($request, $company, $person);
+}
+
+
+# private method _main_screen
+#
+# this attaches everything other than {company} to $request and displays it.
+
+sub _main_screen {
+ my ($request, $company, $person) = @_;
+
+
+ # DIVS logic
+ my @DIVS;
+ my @entity_files;
+ my @eca_files;
+ if ($company->{entity_id} or $person->{entity_id}){
+ my $entity_id = $company->{entity_id};
+ $entity_id ||= $person->{entity_id};
+ @DIVS = qw(credit address contact_info bank_act notes files);
+ unshift @DIVS, 'company' if $company->{entity_id};
+ unshift @DIVS, 'person' if $person->{entity_id};
+ @entity_files = LedgerSMB::File->list(
+ {ref_key => $entity_id, file_class => '4'}
+ );
+ } else {
+ @DIVS = qw(company person);
+ }
+ $request->{target_div} ||= 'company';
+
+ my %DIV_LABEL = (
+ company => $locale->text('Company'),
+ person => $locale->text('Person'),
+ credit => $locale->text('Credit Accounts'),
+ address => $locale->text('Addresses'),
+ contact_info => $locale->text('Contact Info'),
+ bank_act => $locale->text('Bank Accounts'),
+ notes => $locale->text('Notes'),
+ files => $locale->text('Files'),
+ );
+
+ # DIVS contents
+ my $entity_id = $company->{entity_id};
+ $entity_id ||= $person->{entity_id};
+ my @credit_list =
+ LedgerSMB::DBObject::Entity::Credit_Account->list_for_entity(
+ $entity_id,
+ $request->{entity_class}
+ );
+ my $credit_act;
+ for my $ref(@credit_list){
+ if (($request->{credit_id} eq $ref->{id})
+ or ($request->{meta_number} eq $ref->{meta_number})){
+
+ $credit_act = $ref;
+ @eca_files = LedgerSMB::File->list(
+ {ref_key => $ref->{id}, file_class => '5'}
+ );
+
+ }
+ }
+
+ my $entity_class = $credit_act->{entity_class};
+ $entity_class ||= $company->{entity_class};
+ $entity_class ||= $request->{entity_class};
+ $entity_class ||= $request->{account_class};
+ my @locations = LedgerSMB::DBObject::Entity::Location->get_active(
+ {entity_id => $entity_id,
+ credit_id => $credit_act->{id}}
+ );
+
+ my @contact_class_list =
+ LedgerSMB::DBObject::Entity::Contact->list_classes;
+
+ my @contacts = LedgerSMB::DBObject::Entity::Contact->list(
+ {entity_id => $entity_id,
+ credit_id => $credit_act->{id}}
+ );
+ my @bank_account =
+ LedgerSMB::DBObject::Entity::Bank->list($entity_id);
+ my @notes =
+ LedgerSMB::DBObject::Entity::Note->list($entity_id,
+ $credit_act->{id});
+
+ # Globals for the template
+ my @salutations = $request->call_procedure(
+ procname => 'person__list_salutations'
+ );
+ my @all_taxes = $request->call_procedure(procname => 'account__get_taxes');
+
+ my @ar_ap_acc_list = $request->call_procedure(procname => 'chart_get_ar_ap',
+ args => [$entity_class]);
+
+ my @cash_acc_list = $request->call_procedure(procname => 'chart_list_cash',
+ args => [$entity_class]);
+
+ my @discount_acc_list =
+ $request->call_procedure(procname => 'chart_list_discount',
+ args => [$entity_class]);
+
+ for my $var (..hidden.., ..hidden.., ..hidden..){
+ for my $ref (@$var){
+ $ref->{text} = "$ref->{accno}--$ref->{description}";
+ }
+ }
+
+#
+ my @language_code_list =
+ $request->call_procedure(procname=> 'person__list_languages');
+
+ for my $ref (@language_code_list){
+ $ref->{text} = "$ref->{code}--$ref->{description}";
+ }
+
+ my @location_class_list =
+ $request->call_procedure(procname => 'location_list_class');
+
+ my @business_types =
+ $request->call_procedure(procname => 'business_type__list');
+
+ my ($curr_list) =
+ $request->call_procedure(procname => 'setting__get_currencies');
+
+ my @all_currencies;
+ for my $curr (@{$curr_list->{'setting__get_currencies'}}){
+ push @all_currencies, { text => $curr};
+ }
+
+ my ($default_country) = $request->call_procedure(
+ procname => 'setting_get',
+ args => ['default_country']);
+ $default_country = $default_country->{value};
+
+ my ($default_language) = $request->call_procedure(
+ procname => 'setting_get',
+ args => ['default_language']);
+ $default_language = $default_language->{value};
+
+ my $attach_level_options = [
+ {text => $locale->text('Entity'), value => 1} ];
+ ..hidden..,
+ {text => $locale->text('Credit Account'),
+ value => 3} if $credit_act->{id};
+ ;
+
+ $request->close_form();
+ $request->open_form();
+
+ # Template info and rendering
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ template => 'contact',
+ locale => $request->{_locale},
+ path => 'UI/Contact',
+ format => 'HTML'
+ );
+
+ use Data::Dumper;
+ $Data::Dumper::Sortkeys = 1;
+ #die '<pre>' . Dumper($request) . '</pre>';
+ my @country_list = $request->call_procedure(
+ procname => 'location_list_country'
+ );
+ my @entity_classes = $request->call_procedure(
+ procname => 'entity__list_classes'
+ );
+
+ $template->render({
+ DIVS => ..hidden..,
+ DIV_LABEL => \%DIV_LABEL,
+ request => $request,
+ company => $company,
+ person => $person,
+ country_list => ..hidden..,
+ credit_act => $credit_act,
+ credit_list => ..hidden..,
+ entity_classes => ..hidden..,
+ locations => ..hidden..,
+ contacts => ..hidden..,
+ bank_account => ..hidden..,
+ notes => ..hidden..,
+ entity_files => ..hidden..,
+ eca_files => ..hidden..,
+ # globals
+ form_id => $request->{form_id},
+ salutations => ..hidden..,
+ ar_ap_acc_list => ..hidden..,
+ cash_acc_list => ..hidden..,
+ discount_acc_list => ..hidden..,
+ language_code_list => ..hidden..,
+ all_currencies => ..hidden..,
+ attach_level_options => $attach_level_options,
+ entity_id => $entity_id,
+ entity_class => $entity_class,
+ location_class_list => ..hidden..,
+ contact_class_list => ..hidden..,
+ });
+}
+
+=item generate_control_code
+
+Generates a control code and hands off execution to other routines
+
+=cut
+
+sub generate_control_code {
+ my ($request) = @_;
+ my ($ref) = $request->call_procedure(
+ procname => 'setting_increment',
+ args => ['entity_control']
+ );
+ ($request->{control_code}) = values %$ref;
+ _main_screen($request, $request, $request);
+}
+
+=item dispatch_legacy
+
+This is a semi-private method which interfaces with the old code. Note that
+as long as any other functions use this, the contact interface cannot be said to
+be safe for code caching.
+
+Not fully documented because this will go away as soon as possible.
+
+=cut
+
+sub dispatch_legacy {
+ our ($request) = shift @_;
+ use LedgerSMB::Form;
+ no strict;
+ use Data::Dumper;
+ my $aa;
+ my $inv;
+ my $otype;
+ my $qtype;
+ my $cv;
+ $request->{account_class} ||= $request->{entity_class};
+ if ($request->{account_class} == 1){
+ $aa = 'ap';
+ $inv = 'ir';
+ $otype = 'purchase_order';
+ $qtype = 'request_quotation';
+ $cv = 'vendor';
+ } elsif ($request->{account_class} == 2){
+ $aa = 'ar';
+ $inv = 'is';
+ $otype = 'sales_order';
+ $qtype = 'sales_quotation';
+ $cv = 'customer';
+ } else {
+ $request->error($request->{_locale}->text('Unsupported account type'));
+ }
+ our $dispatch =
+ {
+ add_transaction => {script => "bin/$aa.pl",
+ data => {"${cv}_id" => $request->{credit_id}},
+ },
+ add_invoice => {script => "bin/$inv.pl",
+ data => {"${cv}_id" => $request->{credit_id}},
+ },
+ add_order => {script => 'bin/oe.pl',
+ data => {"${cv}_id" => $request->{credit_id},
+ type => $otype,
+ vc => $cv,
+ },
+ },
+ rfq => {script => 'bin/oe.pl',
+ data => {"${cv}_id" => $request->{credit_id},
+ type => $qtype,
+ vc => $cv,
+ },
+ },
+
+ };
+
+ our $form = new Form;
+ our %myconfig = ();
+ %myconfig = %{$request->{_user}};
+ $form->{stylesheet} = $myconfig{stylesheet};
+ our $locale = $request->{_locale};
+
+ for (keys %{$dispatch->{$request->{action}}->{data}}){
+ $form->{$_} = $dispatch->{$request->{action}}->{data}->{$_};
+ }
+
+ my $script = $dispatch->{$request->{action}}{script};
+ $form->{script} = $script;
+ $form->{action} = 'add';
+ $form->{dbh} = $request->{dbh};
+ $form->{script} =~ s|.*/||;
+ { no strict; no warnings 'redefine'; do $script; }
+
+ $form->{action}();
+}
+
+=item add_transaction
+
+Dispatches to the Add (AR or AP as appropriate) transaction screen.
+
+=cut
+
+sub add_transaction {
+ my $request = shift @_;
+ dispatch_legacy($request);
+}
+
+=item add_invoice
+
+Dispatches to the (sales or vendor, as appropriate) invoice screen.
+
+=cut
+
+sub add_invoice {
+ my $request = shift @_;
+ dispatch_legacy($request);
+}
+
+=item add_order
+
+Dispatches to the sales/purchase order screen.
+
+=cut
+
+sub add_order {
+ my $request = shift @_;
+ dispatch_legacy($request);
+}
+
+=item rfq
+
+Dispatches to the quotation/rfq screen
+
+=cut
+
+sub rfq {
+ my $request = shift @_;
+ dispatch_legacy($request);
+}
+
+=item add
+
+This method creates a blank screen for entering a company's information.
+
+=cut
+
+sub add {
+ my ($request) = @_;
+ $request->{target_div} = 'company_div';
+ _main_screen($request, $request);
+}
+
+=item save_company
+
+Saves a company and moves on to the next screen
+
+=cut
+
+sub save_company {
+ my ($request) = @_;
+ my $company = LedgerSMB::DBObject::Entity::Company->new(%$request);
+ $request->{target_div} = 'credit_div';
+ _main_screen($request, $company->save);
+}
+
+=item save_person
+
+Saves a person and moves on to the next screen
+
+=cut
+
+sub save_person {
+ my ($request) = @_;
+ my $person = LedgerSMB::DBObject::Entity::Person->new(
+ %$request
+ );
+ use Data::Dumper;
+ $Data::Dumper::Sortkeys = 1;
+ $request->{target_div} = 'credit_div';
+ $person->save;
+ _main_screen($request, undef, $person);
+}
+
+=item save_credit($request)
+
+This inserts or updates a credit account of the sort listed here.
+
+=cut
+
+sub save_credit {
+
+ my ($request) = @_;
+ $request->{target_div} = 'credit_div';
+ my $company;
+ my @taxes;
+
+ if (!$request->{ar_ap_account_id}){
+ $request->error(
+ $request->{_locale}->text('No AR or AP Account Selected')
+ );
+ }
+
+ $request->{tax_ids} = [];
+ for my $key(keys %$request){
+ if ($key =~ /^taxact_(\d+)$/){
+ my $tax = $1;
+ push @{$request->{tax_ids}}, $tax;
+ }
+ }
+ if ($request->close_form){
+ LedgerSMB::DBObject::Entity::Credit_Account->prepare_input($request);
+ my $credit = LedgerSMB::DBObject::Entity::Credit_Account->new(%$request);
+ $credit = $credit->save();
+ $request->{meta_number} = $credit->{meta_number};
+ }
+ get($request);
+}
+
+=item save_credit_new($request)
+
+This inserts a new credit account.
+
+=cut
+
+
+sub save_credit_new {
+ my ($request) = @_;
+ $request->{credit_id} = undef;
+ save_credit($request);
+}
+
+=item save_location
+
+Adds a location to the company as defined in the inherited object
+
+=cut
+
+sub save_location {
+ my ($request) = @_;
+
+ my $location = LedgerSMB::DBObject::Entity::Location->new(%$request);
+ if ($request->{attach_to} eq '1'){
+ $location->credit_id(undef);
+ }
+ $location->id($request->{location_id});
+ $location->save;
+ $request->{target_div} = 'address_div';
+ get($request);
+
+}
+
+=item save_new_location
+
+Adds a location to the company as defined in the inherited object, not
+overwriting existing locations.
+
+=cut
+
+sub save_new_location {
+ my ($request) = @_;
+ delete $request->{location_id};
+ save_location($request);
+}
+
+=item edit
+
+This is a synonym of get() which is preferred to use for editing operations.
+
+=cut
+
+sub edit {
+ get (@_);
+}
+
+=item delete_location
+
+Deletes the specified location
+
+=cut
+
+sub delete_location {
+ my ($request) = @_;
+ my $location = LedgerSMB::DBObject::Entity::Location->new(%$request);
+ $location->id($request->{location_id});
+ if (!$request->{is_for_credit}){
+ $location->credit_id(undef);
+ }
+ $location->delete;
+ $request->{target_div} = 'address_div';
+ get($request);
+}
+
+=item save_contact
+
+Saves the specified contact info
+
+=cut
+
+sub save_contact {
+ my ($request) = @_;
+ my $contact = LedgerSMB::DBObject::Entity::Contact->new(%$request);
+ if ($request->{attach_to} == 1){
+ $contact->credit_id(undef);
+ }
+ $contact->save;
+ $request->{target_div} = 'address_div';
+ $request->{target_div} = 'contact_info_div';
+ get($request);
+}
+
+=item delete_contact
+
+Deletes the specified contact info. Note that for_credit is used to pass the
+credit id over in this case.
+
+=cut
+
+sub delete_contact {
+ my ($request) = @_;
+ my $contact = LedgerSMB::DBObject::Entity::Contact->new(%$request);
+ $contact->credit_id($request->{for_credit});
+ $contact->delete;
+ $request->{target_div} = 'contact_info_div';
+ get($request);
+}
+
+=item delete_bank_acct
+
+Deletes the selected bank account record
+
+Required request variables:
+* bank_account_id
+* entity_id
+* form_id
+
+=cut
+
+sub delete_bank_account{
+ my ($request) = @_;
+ my $account = LedgerSMB::DBObject::Entity::Bank->new(%$request);
+ $account->delete;
+ $request->{target_div} = 'bank_act_div';
+ get($request);
+}
+
+=item save_bank_account
+
+Adds a bank account to a company and, if defined, an entity credit account.
+
+=cut
+
+sub save_bank_account {
+ my ($request) = @_;
+ my $bank = LedgerSMB::DBObject::Entity::Bank->new(%$request);
+ $bank->save;
+ $request->{target_div} = 'bank_act_div';
+ get($request);
+}
+
+=item save_notes($request)
+
+Saves notes. entity_id or credit_id must be set, as must note_class, note, and
+subject.
+
+=cut
+
+sub save_notes {
+ my ($request) = @_;
+ my $note = LedgerSMB::DBObject::Entity::Note->new(%$request);
+ if ($request->{note_class} == 1){
+ $note->credit_id(undef);
+ }
+ $note->save;
+ get($request);
+}
+
+=item get_pricelist
+
+This returns and displays the pricelist. The id field is required.
+
+=cut
+
+sub get_pricelist {
+ my ($request) = @_;
+ my $credit = LedgerSMB::DBObject::Entity::Credit_Account->get_by_id(
+ $request->{credit_id}
+ );
+ my $pricelist = $credit->get_pricematrix;
+ $request->merge($credit) if $credit;
+ $request->merge($pricelist) if $pricelist;
+ my $template = LedgerSMB::Template->new(
+ user => $request->{_user},
+ path => 'UI/Contact' ,
+ template => 'pricelist',
+ format => uc($request->{format} || 'HTML'),
+ locale => $request->{_locale},
+ );
+
+ $template->render($request);
+}
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (c) 2012, 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;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.