[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

SF.net SVN: ledger-smb:[4963] addons/1.3



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.