[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
SF.net SVN: ledger-smb:[6175] addons/1.3
- Subject: SF.net SVN: ledger-smb:[6175] addons/1.3
- From: ..hidden..
- Date: Thu, 24 Oct 2013 04:32:47 +0000
Revision: 6175
http://sourceforge.net/p/ledger-smb/code/6175
Author: einhverfr
Date: 2013-10-24 04:32:45 +0000 (Thu, 24 Oct 2013)
Log Message:
-----------
Adding new sequences addon, backport of 1.4 code
Added Paths:
-----------
addons/1.3/sequences/
addons/1.3/sequences/trunk/
addons/1.3/sequences/trunk/LedgerSMB/
addons/1.3/sequences/trunk/LedgerSMB/DBObject.pm
addons/1.3/sequences/trunk/LedgerSMB/DBObject_Moose.pm
addons/1.3/sequences/trunk/LedgerSMB/Setting/
addons/1.3/sequences/trunk/LedgerSMB/Setting/Sequence.pm
addons/1.3/sequences/trunk/LedgerSMB/Setting.pm
addons/1.3/sequences/trunk/configuration.pl
addons/1.3/sequences/trunk/patches/
addons/1.3/sequences/trunk/patches/code_series_patch.diff
addons/1.3/sequences/trunk/scripts/
addons/1.3/sequences/trunk/scripts/configuration.pl
Copied: addons/1.3/sequences/trunk/LedgerSMB/DBObject.pm (from rev 6140, trunk/LedgerSMB/DBObject.pm)
===================================================================
--- addons/1.3/sequences/trunk/LedgerSMB/DBObject.pm (rev 0)
+++ addons/1.3/sequences/trunk/LedgerSMB/DBObject.pm 2013-10-24 04:32:45 UTC (rev 6175)
@@ -0,0 +1,331 @@
+
+
+=head1 NAME
+
+LedgerSMB::DBObject - LedgerSMB class for building objects from db relations
+
+=head1 SYOPSIS
+
+This module creates object instances based on LedgerSMB's in-database ORM.
+
+=head1 METHODS
+
+=over
+
+=item new ($class, base => $LedgerSMB::hash)
+
+This is the base constructor for all child classes. It must be used with base
+argument because this is necessary for database connectivity and the like.
+
+Of course the base object can be any object that inherits LedgerSMB, so you can
+use any subclass of that. The per-session dbh is passed between the objects
+this way as is any information that is needed.
+
+=item exec_method
+
+($self, procname => $function_name, [args => ..hidden.., schema => $schema,
+continue_on_error=>$continue_on_error])
+
+Provides the basic mapping of parameters to the SQL stored procedure function
+arguments.
+
+If ..hidden.. is not defined, args are mapped from the object's properties,
+stripping them of their in_ prefix. If schema is provided, that is used
+instead of PostgreSQL's search path. If continue_on_error is provided and true,
+the operation will not raise an exception in the event of a database error, and
+it will be up to the application to handle any exceptions.
+
+=item __validate__ is called on every new() invocation. It is blank in this
+module but can be overridden in decendant modules.
+
+=item _db_array_scalars(@elements) creates a db array from scalars.
+
+=item _db_array_literal(@elements) creates a multiple dimension db array from
+ preparsed db arrays or other data which does not need to be escaped.
+
+=cut
+
+package LedgerSMB::DBObject;
+use Scalar::Util;
+use base qw(LedgerSMB);
+use Log::Log4perl;
+use LedgerSMB::App_State;
+use strict;
+use warnings;
+
+my $logger = Log::Log4perl->get_logger('LedgerSMB::DBObject');
+
+sub __validate__ {}
+
+sub new {
+ my $class = shift @_;
+ my %args = (ref($_[0]) eq 'HASH')? %{$_[0]}: @_;
+ my $base = $args{base};
+ my $mode = $args{copy};
+ $mode = '' if (!defined $mode);
+ my $self = bless {}, $class;
+ my @mergelist;
+ if ( defined $args{merge} ){
+ @mergelist = @{ $args{merge} };
+ } elsif (defined $mode && ( $mode eq 'list')) {
+ $self->error('Mergelist not set');
+ }
+ else {
+ @mergelist = ();
+ }
+
+ my $attr;
+ if (lc($mode) eq 'base'){
+ $self->merge($base, keys => ['dbh', '_roles', '_user', '_locale',
+ '_request']);
+ }
+ elsif (lc($mode) eq 'list'){
+ $self->merge($base, keys => ['dbh', '_roles', '_user', '_locale',
+ '_request']);
+ $self->merge($base, keys => ..hidden..);
+ }
+ else {
+ $self->merge($base);
+ }
+ $self->__validate__();
+ $self->{_order_method} = {};
+ return $self;
+}
+
+=item set_ordering
+
+Sets the ordering used by default for specific functions called by exec_method
+
+=cut
+
+sub set_ordering {
+ my ($self, $args) = @_;
+ my $dbh = $LedgerSMB::App_State::DBH;
+ $self->{_order_method}->{$args->{method}} =
+ $dbh->quote_identifier($args->{column});
+}
+
+sub exec_method {
+ use DBD::Pg qw(:pg_types);
+ my $self = shift @_;
+ my %args = (ref($_[0]) eq 'HASH')? %{$_[0]}: @_;
+ my $funcname = $args{funcname};
+ my $dbh = $LedgerSMB::App_State::DBH;
+ die 'No Database Handle' unless $dbh;
+
+ my $schema = $args{schema} || $LedgerSMB::Sysconfig::db_namespace;
+
+ $logger->debug("exec_method: \$funcname = $funcname");
+ my @in_args;
+ @in_args = @{ $args{args} } if $args{args};
+
+ my @call_args;
+
+ my $query = "
+ SELECT proname, pronargs, proargnames, proargtypes FROM pg_proc
+ WHERE proname = ?
+ AND pronamespace =
+ coalesce((SELECT oid FROM pg_namespace WHERE nspname = ?),
+ pronamespace)
+ ";
+ my $sth = $dbh->prepare(
+ $query
+ );
+ $sth->execute($funcname, $schema)
+ || $self->error($DBI::errstr . "in exec_method");
+ my $ref;
+
+ $ref = $sth->fetchrow_hashref('NAME_lc');
+
+ my $pargs = $ref->{proargnames};
+ my @proc_args;
+ my @proargtypes = split / /, $ref->{proargtypes} if $ref->{proargtypes};
+
+ if ( !$ref->{proname} ) { # no such function
+ # If the function doesn't exist, $funcname gets zeroed?
+ $self->error( "No such function: $funcname");
+# die;
+ }
+ $ref->{pronargs} = 0 unless defined $ref->{pronargs};
+ # If the user provided args..
+ if (!defined $args{args}) {
+ @proc_args = $self->_parse_array($pargs);
+ if (@proc_args) {
+ for my $arg (@proc_args) {
+ my $atype = shift @proargtypes;
+ #print STDERR "User Provided Args: $arg\n";
+ if ( $arg =~ s/^in_// ) {
+ if ( defined $self->{$arg} )
+ {
+ $logger->debug("exec_method pushing $arg = $self->{$arg}");
+ }
+ else
+ {
+ $logger->debug("exec_method pushing \$arg defined $arg | \$self->{\$arg} is undefined");
+ #$self->{$arg} = undef; # Why was this being unset? --CT
+ }
+ if ($atype == 17){
+ push ( @call_args, { value => $self->{$arg} ,
+ type => DBD::Pg::PG_BYTEA });
+ } else {
+ push ( @call_args, $self->{$arg} );
+ }
+ }
+ }
+ }
+ for (@in_args) { push @call_args, $_ } ;
+ $self->{call_args} = ..hidden..;
+ $logger->debug("exec_method: \$self = " . Data::Dumper::Dumper($self));
+ return $self->call_procedure( procname => $funcname,
+ args => ..hidden..,
+ order_by => $self->{_order_method}->{"$funcname"},
+ schema=>$schema,
+ continue_on_error => $args{continue_on_error});
+ }
+ else {
+ return $self->call_procedure( procname => $funcname,
+ args => ..hidden..,
+ order_by => $self->{_order_method}->{"$funcname"},
+ schema=>$schema,
+ continue_on_error => $args{continue_on_error});
+ }
+}
+
+
+=item run_custom_queries
+
+Backward-compatible with 1.2 custom query system for moving forward.
+
+=cut
+
+sub run_custom_queries {
+ my ( $self, $tablename, $query_type, $linenum ) = @_;
+ my $dbh = $self->{dbh};
+ if ( $query_type !~ /^(select|insert|update)$/i ) {
+
+ # Commenting out this next bit until we figure out how the locale object
+ # will operate. Chris
+ #$self->error($locale->text(
+ # "Passed incorrect query type to run_custom_queries."
+ #));
+ }
+ my @rc;
+ my %temphash;
+ my @templist;
+ my $did_insert;
+ my @elements;
+ my $query;
+ my $ins_values;
+
+ if ($linenum) {
+ $linenum = "_$linenum";
+ }
+
+ $query_type = uc($query_type);
+ for ( @{ $self->{custom_db_fields}{$tablename} } ) {
+ @elements = split( /:/, $_ );
+ push @{ $temphash{ $elements[0] } }, $elements[1];
+ }
+ for ( keys %temphash ) {
+ my @data;
+ $query = "$query_type ";
+ if ( $query_type eq 'UPDATE' ) {
+ $query = "DELETE FROM $_ WHERE row_id = ?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $self->{ "id" . "$linenum" } )
+ || $self->dberror($query);
+ }
+ elsif ( $query_type eq 'INSERT' ) {
+ $query .= " INTO $_ (";
+ }
+ my $first = 1;
+ for ( @{ $temphash{$_} } ) {
+ $query .= "$_";
+ if ( $query_type eq 'UPDATE' ) {
+ $query .= '= ?';
+ }
+ $ins_values .= "?, ";
+ $query .= ", ";
+ $first = 0;
+ if ( $query_type eq 'UPDATE' or $query_type eq 'INSERT' ) {
+ push @data, $self->{"$_$linenum"};
+ }
+ }
+ if ( $query_type ne 'INSERT' ) {
+ $query =~ s/, $//;
+ }
+ if ( $query_type eq 'SELECT' ) {
+ $query .= " FROM $_";
+ }
+ if ( $query_type eq 'SELECT' or $query_type eq 'UPDATE' ) {
+ $query .= " WHERE row_id = ?";
+ }
+ if ( $query_type eq 'INSERT' ) {
+ $query .= " row_id) VALUES ($ins_values ?)";
+ }
+ if ( $query_type eq 'SELECT' ) {
+ push @rc, [$query];
+ }
+ else {
+ unshift( @data, $query );
+ push @rc, ..hidden..;
+ }
+ }
+ if ( $query_type eq 'INSERT' ) {
+ for (@rc) {
+ $query = shift( @{$_} );
+ my $sth = $dbh->prepare($query)
+ || $self->db_error($query);
+ $sth->execute( @{$_}, $self->{id} )
+ || $self->dberror($query);
+ $sth->finish;
+ $did_insert = 1;
+ }
+ }
+ elsif ( $query_type eq 'UPDATE' ) {
+ @rc = $self->run_custom_queries( $tablename, 'INSERT', $linenum );
+ }
+ elsif ( $query_type eq 'SELECT' ) {
+ for (@rc) {
+ $query = shift @{$_};
+ my $sth = $self->{dbh}->prepare($query);
+ $sth->execute( $self->{id} );
+ my $ref = $sth->fetchrow_hashref('NAME_lc');
+ $self->merge( $ref, keys(%$ref) );
+ }
+ }
+ return @rc;
+}
+
+sub _parse_array {
+ my ($self, $value) = @_;
+ return @$value if ref $value eq 'ARRAY';
+ return if !defined $value;
+ # No longer needed since we require DBD::Pg 2.x
+}
+
+sub _db_array_scalars {
+ my $self = shift @_;
+ my @args = @_;
+ return ..hidden..;
+ # No longer needed since we require DBD::Pg 2.x
+}
+
+sub _db_array_literal {
+ my $self = shift @_;
+ my @args = @_;
+ return ..hidden..;
+ # No longer needed since we require DBD::Pg 2.x
+}
+
+1;
+
+=back
+
+=head1 Copyright (C) 2007, 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: addons/1.3/sequences/trunk/LedgerSMB/DBObject_Moose.pm (from rev 6140, trunk/LedgerSMB/DBObject_Moose.pm)
===================================================================
--- addons/1.3/sequences/trunk/LedgerSMB/DBObject_Moose.pm (rev 0)
+++ addons/1.3/sequences/trunk/LedgerSMB/DBObject_Moose.pm 2013-10-24 04:32:45 UTC (rev 6175)
@@ -0,0 +1,141 @@
+=head1 NAME
+
+LedgerSMB::DBObject_Moose - LedgerSMB class for building objects from db
+relations, now with Moose!
+
+=head1 SYOPSIS
+
+This module creates object instances based on LedgerSMB's in-database ORM, using Moose.
+
+=cut
+
+package LedgerSMB::DBObject_Moose;
+use Moose::Role;
+use LedgerSMB::DBObject;
+use LedgerSMB;
+use Scalar::Util;
+use Log::Log4perl;
+use LedgerSMB::DBObject;
+use Moose::Util::TypeConstraints;
+use LedgerSMB::MooseTypes
+
+=head1 METHODS
+
+=over
+
+=item new ($class, base => $LedgerSMB::hash)
+
+This is the base constructor for all child classes. It must be used with base
+argument because this is necessary for database connectivity and the like.
+
+Of course the base object can be any object that inherits LedgerSMB, so you can
+use any subclass of that. The per-session dbh is passed between the objects
+this way as is any information that is needed.
+
+=item exec_method
+
+($self, procname => $function_name, [args => ..hidden.., schema => $schema,
+continue_on_error=>$continue_on_error])
+
+Provides the basic mapping of parameters to the SQL stored procedure function
+arguments.
+
+If ..hidden.. is not defined, args are mapped from the object's properties,
+stripping them of their in_ prefix. If schema is provided, that is used
+instead of PostgreSQL's search path. If continue_on_error is provided and true,
+the operation will not raise an exception in the event of a database error, and
+it will be up to the application to handle any exceptions.
+
+=item _db_array_scalars(@elements) creates a db array from scalars.
+
+=item _db_array_literal(@elements) creates a multiple dimension db array from
+ preparsed db arrays or other data which does not need to be escaped.
+
+=cut
+
+my $logger = Log::Log4perl->get_logger('LedgerSMB::DBObject');
+
+sub prepare_dbhash {
+ my $self = shift;
+ my $target = shift;
+ $target->{dbh} = $LedgerSMB::App_State::DBH;
+}
+
+# _to_dbobject
+#Private method used to convert to db object for purposes of function wrapping
+#
+sub _to_dbobject {
+ my $self = shift @_;
+ return LedgerSMB::DBObject->new({base => $self});
+}
+
+=item set_ordering
+
+Sets the ordering used by default for specific functions called by exec_method
+
+=cut
+
+sub exec_method {
+ my $self = shift @_;
+ my $dbo = $self->_to_dbobject;
+ return $dbo->exec_method(@_);
+}
+
+=item run_custom_queries
+
+Backward-compatible with 1.2 custom query system for moving forward.
+
+=cut
+
+sub run_custom_queries {
+ my $self = shift @_;
+ my $dbo = $self->_to_dbobject;
+ return $dbo->run_custom_queries(@_);
+}
+
+sub call_procedure {
+ my $self = shift @_;
+ return LedgerSMB->call_procedure(@_);
+}
+
+# Keeping this here due to common requirements
+sub is_allowed_role {
+ my $self = shift @_;
+ my $dbo = $self->_to_dbobject;
+ return $dbo->is_allowed_role(@_);
+}
+
+sub get_interval_dates {
+ my ($self, $year, $month, $type) = @_;
+ my $start = "$year-$month-01";
+ return {start => undef, end => LedgerSMB::PGDate->from_db($start, 'date')}
+ if $type eq 'none';
+ my $dbh = $LedgerSMB::App_State::DBH;
+ my $intervals = {
+ year => '1 year',
+ month => '1 month',
+ quarter => '3 months'
+ };
+
+ my $sth = $dbh->prepare(
+ "SELECT (?::date + ?::interval - '1 day'::interval)::date"
+ );
+
+ $sth->execute($start, $intervals->{$type});
+ my ($end) = $sth->fetchrow_array();
+ return { start => LedgerSMB::PGDate->from_db($start, 'date'),
+ end => LedgerSMB::PGDate->from_db($end, 'date') };
+}
+
+
+=back
+
+=head1 Copyright (C) 2007, 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
+
+1;
Copied: addons/1.3/sequences/trunk/LedgerSMB/Setting/Sequence.pm (from rev 6171, trunk/LedgerSMB/Setting/Sequence.pm)
===================================================================
--- addons/1.3/sequences/trunk/LedgerSMB/Setting/Sequence.pm (rev 0)
+++ addons/1.3/sequences/trunk/LedgerSMB/Setting/Sequence.pm 2013-10-24 04:32:45 UTC (rev 6175)
@@ -0,0 +1,225 @@
+=head1 NAME
+
+LedgerSMB::Setting::Sequence - Sequence per Setting Handling for LedgerSMB
+
+=head1 SYNPOSIS
+
+To list all sequences:
+
+ my @sequences = LedgerSMB::Setting::Sequence->list();
+
+To list all sequences for a single setting:
+
+ my @sequences = LedgerSMB::Setting::Sequence->list('mysetting');
+
+To save a sequence:
+
+ my $sequence = LedgerSMB::Setting::Sequence->new(%$request);
+ $sequence->save;
+
+=cut
+
+package LedgerSMB::Setting::Sequence;
+use LedgerSMB::Setting;
+use Carp;
+use Moose;
+with 'LedgerSMB::DBObject_Moose';
+
+=head1 DESCRIPTION
+
+This module adds handling of separate invoice sequences to LedgerSMB. The
+module is intended to be called from both pre-1.3 code as well as new code.
+
+This module allows multiple sequences to be "attached" to a given setting. At
+run time, a user may decide to use a sequence or just a setting, and increment
+accordingly.
+
+Increment substitution rules are the same as for LedgerSMB::Setting.
+
+=head1 PROPERTIES
+
+=head2 label
+
+The label is the unique identifier of the sequence.
+
+=cut
+
+has label => (is => 'ro', isa => 'Str', required => 1);
+
+=head2 setting_key
+
+This is the key for the setting the sequence can replace.
+
+=cut
+
+has setting_key => (is => 'ro', isa => 'Str', required => 1);
+
+=head2 prefix
+
+Optional prefix. Default is set in the db.
+
+=cut
+
+has prefix => (is => 'rw', isa => 'Str', required => 0);
+
+=head2 sequence
+
+Optional sequence number. Default is set in the db.
+
+=cut
+
+has sequence => (is => 'rw', isa => 'Str', required => 0);
+
+=head2 suffix
+
+Optional suffix. Default is set in the db.
+
+=cut
+
+has suffix => (is => 'rw', isa => 'Str', required => 0);
+
+=head2 allow_input
+
+If true (the default) then allow user-entered sequence fields.
+
+=cut
+
+has accept_input => (is => 'rw', isa => 'Bool', required => 0);
+
+=head1 METHODS
+
+=head2 get(label, setting_key)
+
+Return the sequence if label is set and exists,
+
+If label is not set but setting_key exists, returns the setting object.
+
+If this fails, dies with an appropriate error.
+
+=cut
+
+sub get{
+ my ($self, $label, $setting_key) = @_;
+
+ if (defined $label){
+ my ($ref) = __PACKAGE__->call_procedure(procname => 'sequence__get', args => [$label]);
+ croak 'Sequence does not exist: ' . $label unless $ref;
+ return $self->new(%$ref);
+ } elsif (defined $setting_key){
+ my ($ref) = __PACKAGE__->call_procedure(procname => 'setting_get', args => [$setting_key]);
+ croak 'Setting does not exist: ' . $setting_key unless $ref;
+ return LedgerSMB::Setting->new($ref);
+ } else {
+ croak 'Neither label nor setting_key defined';
+ }
+}
+
+=head2 list(setting_key)
+
+Lists all sequences applicable. If setting_key is defined, only sequences
+attached to the setting are applicable.
+
+=cut
+
+sub list{
+ my ($self, $setting_key) = @_;
+ my @setting_list;
+ if (defined $setting_key){
+ @setting_list = __PACKAGE__->call_procedure(
+ procname => 'sequence__list_by_key', args => [$setting_key]
+ );
+ } else {
+ @setting_list = __PACKAGE__->call_procedure(procname => 'sequence__list');
+ }
+ for my $s (@setting_list){
+ $s = __PACKAGE__->new(%$s);
+ }
+ return @setting_list;
+}
+
+=head2 save()
+
+Saves the sequence.
+
+=cut
+
+sub save {
+ my ($self) = @_;
+ my ($ref) = $self->exec_method({funcname => 'sequence__save'});
+ return $self->new(%$ref);
+}
+
+=head2 increment(label, vars)
+
+Like the increment method of LedgerSMB::Setting, but works on the sequence.
+
+label is optional and if set to a string will be used as the sequence to
+increment,
+
+=cut
+
+sub increment {
+ my ($self, $val1, $val2) = @_;
+ my $label;
+ my $vars;
+ if (ref $val1 eq ref {}){
+ $vars = $val1;
+ $label = $self->label;
+ } else {
+ $label = $val1;
+ $vars = $val2;
+ }
+ my ($ref) = __PACKAGE__->call_procedure(procname => 'sequence__increment',
+ args => [$label]);
+ my ($value) = values %$ref;
+ return LedgerSMB::Setting::_increment_process($value, $vars);
+
+}
+
+=head2 should_increment($vars, $fldname, [$label]);
+
+If label is provided, used to get new sequence to test.
+
+Returns true if one should increment, false otherwise.
+
+=cut
+
+
+
+sub should_increment{
+ my ($self, $vars, $fldname, $label) = @_;
+
+ if (!$vars->{$fldname}){
+ return 1;
+ }
+ if (!$vars->{setting_sequence}){
+ return 0;
+ }
+ my $sequence = $self;
+ $sequence = LedgerSMB::Setting::Sequence->get($label) if $label;
+ return 0 unless ref $sequence;
+ return 1 unless $sequence->accept_input;
+ return 0;
+}
+
+=head2 delete(label)
+
+Deletes a sequence.
+
+=cut
+
+sub delete {
+ my ($self, $label) = @_;
+ return __PACKAGE__->call_procedure(procname => 'sequence__delete',
+ args => [$label]);
+}
+
+=head1 COPYRIGHT
+
+COPYRIGHT(C) 2013 The LedgerSMB Core Team. This file may be used in accordance
+with the GNU General Public License version 2 or at your option any later
+version. Please see the enclosed LICENSE.TXT for details.
+
+=cut
+
+__PACKAGE__->meta->make_immutable;
Copied: addons/1.3/sequences/trunk/LedgerSMB/Setting.pm (from rev 6147, trunk/LedgerSMB/Setting.pm)
===================================================================
--- addons/1.3/sequences/trunk/LedgerSMB/Setting.pm (rev 0)
+++ addons/1.3/sequences/trunk/LedgerSMB/Setting.pm 2013-10-24 04:32:45 UTC (rev 6175)
@@ -0,0 +1,200 @@
+
+=head1 NAME
+
+LedgerSMB::Setting - LedgerSMB class for managing Business Locations
+
+=head1 SYOPSIS
+
+This module creates object instances based on LedgerSMB's in-database ORM.
+
+=head1 METHODS
+
+The following method is static:
+
+=over
+
+=item new ($LedgerSMB object);
+
+=back
+
+The following methods are passed through to stored procedures:
+
+=over
+
+=item get ($self->{key})
+
+=item set ($self->{key}, $self->{value})
+
+=item parse_increment ($self->{key})
+
+This function updates a default entry in the database, incrimenting the last
+set of digits not including <?lsmb ?> tags or non-digits, and then parses the
+returned value, doing tag substitution. The final value is then returned by
+the function.
+
+=back
+
+The above list may grow over time, and may depend on other installed modules.
+
+=head1 Copyright (C) 2007, 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
+
+package LedgerSMB::Setting;
+use LedgerSMB::App_State;
+use base qw(LedgerSMB::DBObject);
+use strict;
+our $VERSION = '1.0.0';
+
+
+sub get {
+ my $self = shift;
+ my ($key) = @_;
+ $key = $self->{key} unless $key;
+ my ($hashref) = $self->call_procedure( procname => 'setting_get',
+ args => [$key]) ;
+ $self->{value} = $hashref->{value} if ref $self !~ /hash/i;
+ return $hashref->{value};
+}
+
+sub increment {
+
+ my $self = shift;
+ my $myconfig = shift;
+ my $key = shift;
+ $key ||= $self->{key};
+
+ # Long-run, we may want to run this via Parse::RecDescent, but this is
+ # at least a start for here. Chris T.
+
+ # Replaces Form::UpdateDefaults
+
+ my ($retval) = $self->call_procedure(procname => 'setting_increment',
+ args => [$key]) ;
+ my $value = $retval->{setting_increment};
+
+ my $var = _increment_process($value, $self, $myconfig);
+
+ $self->{value} = $var if $self->{key};
+ return $var;
+}
+
+# Increment processing routine, used by only related classes.
+#
+sub _increment_process{
+ my ($value, $self ) = @_;
+# check for and replace
+# <?lsmb DATE ?>, <?lsmb YYMMDD ?>, <?lsmb YEAR ?>, <?lsmb MONTH ?>, <?lsmb DAY ?> or variations of
+# <?lsmb NAME 1 1 3 ?>, <?lsmb BUSINESS ?>, <?lsmb BUSINESS 10 ?>, <?lsmb CURR... ?>
+# <?lsmb DESCRIPTION 1 1 3 ?>, <?lsmb ITEM 1 1 3 ?>, <?lsmb PARTSGROUP 1 1 3 ?> only for parts
+# <?lsmb PHONE ?> for customer and vendors
+
+ my $myconfig = $LedgerSMB::App_State::User;
+ my $dbvar = $value;
+ my $var = $value;
+ my $str;
+ my $param;
+
+ if ($value =~ /<\?lsmb /) {
+
+ while ($value =~ /<\?lsmb /) {
+
+ $value =~ s/(<\?lsmb .*? \?>)//;
+ last unless $&;
+ $param = $1;
+ $str = "";
+
+ if ( $param =~ /<\?lsmb date \?>/i ) {
+ $str = (
+ $self->split_date(
+ $myconfig->{dateformat},
+ $self->{transdate}
+ )
+ )[0];
+ $var =~ s/$param/$str/;
+ }
+
+ if ( $param =~
+/<\?lsmb (name|business|description|item|partsgroup|phone|custom)/i
+ )
+ {
+
+ my $fld = lc $&;
+ $fld =~ s/<\?lsmb //;
+
+ if ( $fld =~ /name/ ) {
+ if ( $self->{type} ) {
+ $fld = $self->{vc};
+ }
+ }
+
+ my $p = $param;
+ $p =~ s/(<|>|%)//g;
+ my @p = split / /, $p;
+ my @n = split / /, uc $self->{$fld};
+
+ if ( $#p > 0 ) {
+
+ for ( my $i = 1 ; $i <= $#p ; $i++ ) {
+ $str .= substr( $n[ $i - 1 ], 0, $p[$i] );
+ }
+
+ }
+ else {
+ ($str) = split /--/, $self->{$fld};
+ }
+
+ $var =~ s/$param/$str/;
+ $var =~ s/\W//g if $fld eq 'phone';
+ }
+
+ if ( $param =~ /<\?lsmb (yy|mm|dd)/i ) {
+ # SC: XXX Does this even work anymore?
+ my $p = $param;
+ $p =~ s/lsmb//;
+ $p =~ s/[^YyMmDd]//g;
+ my %d = ( yy => 1, mm => 2, dd => 3 );
+ my $str = $p;
+
+ my @a = $self->split_date( $myconfig->{dateformat},
+ $self->{transdate} );
+ for my $k( keys %d ) { $str =~ s/$k/$a[ $d{$k} ]/i}
+ $var =~ s/\Q$param\E/$str/i;
+ }
+
+ if ( $param =~ /<\?lsmb curr/i ) {
+ $var =~ s/$param/$self->{currency}/;
+ }
+ }
+ }
+ return $var;
+}
+
+sub get_currencies {
+ my $self = shift;
+ my @data = $self->exec_method(funcname => 'setting__get_currencies');
+ @{$self->{currencies}} = $self->_parse_array($data[0]->{setting__get_currencies});
+ return @{$self->{currencies}};
+}
+
+sub set {
+ my ($self, $key, $value) = @_;
+ $key ||= $self->{key};
+ $value ||= $self->{value};
+ $self->call_procedure(procname => 'setting__set',
+ args => [$key, $value]);
+}
+
+sub accounts_by_link {
+ my ($self, $link) = @_;
+ my @results = $self->call_procedure(procname => 'account__get_by_link_desc',
+ args => [$link]);
+ for my $ref (@results){
+ $ref->{text} = "$ref->{accno} -- $ref->{description}";
+ }
+ return ..hidden..;
+}
Copied: addons/1.3/sequences/trunk/configuration.pl (from rev 6140, trunk/configuration.pl)
===================================================================
--- addons/1.3/sequences/trunk/configuration.pl (rev 0)
+++ addons/1.3/sequences/trunk/configuration.pl 2013-10-24 04:32:45 UTC (rev 6175)
@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+
+use FindBin;
+BEGIN {
+ lib->import($FindBin::Bin) unless $ENV{mod_perl}
+}
+require "lsmb-request.pl";
Added: addons/1.3/sequences/trunk/patches/code_series_patch.diff
===================================================================
--- addons/1.3/sequences/trunk/patches/code_series_patch.diff (rev 0)
+++ addons/1.3/sequences/trunk/patches/code_series_patch.diff 2013-10-24 04:32:45 UTC (rev 6175)
@@ -0,0 +1,379 @@
+Index: LedgerSMB/AA.pm
+===================================================================
+--- LedgerSMB/AA.pm (revision 6140)
++++ LedgerSMB/AA.pm (working copy)
+@@ -103,7 +103,7 @@
+ $invnumber = "vinumber";
+ }
+ $form->{invnumber} = $form->update_defaults( $myconfig, $invnumber )
+- unless $form->{invnumber};
++ if $form->should_update_defaults('invnumber');
+
+ if ( $form->{currency} eq $form->{defaultcurrency} ) {
+ $form->{exchangerate} = 1;
+Index: LedgerSMB/Form.pm
+===================================================================
+--- LedgerSMB/Form.pm (revision 6140)
++++ LedgerSMB/Form.pm (working copy)
+@@ -67,6 +67,7 @@
+ use LedgerSMB::PGNumber;
+ use Log::Log4perl;
+ use LedgerSMB::App_State;
++use LedgerSMB::Setting::Sequence;
+
+ use charnames qw(:full);
+ use open ':utf8';
+@@ -3321,6 +3322,10 @@
+ sub update_defaults {
+
+ my ( $self, $myconfig, $fld,$dbh_parm,$nocommit) = @_;
++ if ($self->{setting_sequence}){
++ return LedgerSMB::Setting::Sequence->increment(
++ $self->{setting_sequence}, $self);
++ }
+
+ if ( !$self->{dbh} && $self ) {
+ $self->db_init($myconfig);
+@@ -3464,6 +3469,26 @@
+ return $var;
+ }
+
++=item should_update_defaults(fldname)
++
++This should be used instead of direct tests, and checks for a sequence selected.
++
++=cut
++
++sub should_update_defaults {
++ my ($self, $fldname) = @_;
++ if (!$self->{$fldname}){
++ return 1;
++ }
++ if (!$self->{setting_sequence}){
++ return 0;
++ }
++
++ my $sequence = LedgerSMB::Setting::Sequence->get($self->{setting_sequence});
++ return 1 unless $sequence->accept_input;
++ return 0;
++}
++
+ =item $form->db_prepare_vars(var1, var2, ..., varI<n>)
+
+ Undefines $form->{varI<m>}, 1 <= I<m> <= I<n>, iff $form-<{varI<m> is both
+@@ -3753,6 +3778,32 @@
+
+ }
+
++=item sequence_dropdown(setting_key)
++
++This function returns the HTML code for a dropdown box for a given setting
++key. It is not generally to be used with code on new templates.
++
++=cut
++
++sub sequence_dropdown{
++ my ($self, $setting_key) = @_;
++ return undef if $self->{id};
++ my @sequences = LedgerSMB::Setting::Sequence->list($setting_key);
++ my $retval = qq|<select name='setting_sequence' class='sequence'>\n|;
++ $retval .= qq|<option></option>|;
++ for my $seq (@sequences){
++ my $selected = '';
++ my $label = $seq->label;
++ $selected = "SELECTED='SELECTED'"
++ if $self->{setting_sequence} eq $label;
++ $retval .= qq|<option value='$label' $selected>$label</option>\n|;
++ }
++ $retval .= "</select>";
++ if (@sequences){
++ return $retval;
++ } else {
++ return undef
++ }
++}
+ #end decrysiption
+
+ 1;
+Index: bin/aa.pl
+===================================================================
+--- bin/aa.pl (revision 6140)
++++ bin/aa.pl (working copy)
+@@ -161,6 +161,12 @@
+ }
+
+ sub display_form {
++ my $invnumber = "sinumber";
++ if ( $form->{vc} eq 'vendor' ) {
++ $invnumber = "vinumber";
++ }
++ $form->{sequence_select} = $form->sequence_dropdown($invnumber)
++ unless $form->{id};
+ $form->{format} = $form->get_setting('format') unless $form->{format};
+ $form->close_form;
+ $form->open_form;
+@@ -662,7 +668,8 @@
+ $employee
+ <tr>
+ <th align=right nowrap>| . $locale->text('Invoice Number') . qq|</th>
+- <td><input name=invnumber size=20 value="$form->{invnumber}"></td>
++ <td><input name=invnumber size=20 value="$form->{invnumber}">
++ $form->{sequence_select}</td>
+ </tr>
+ <tr>
+ <th align=right nowrap>| . $locale->text('Order Number') . qq|</th>
+Index: LedgerSMB/IS.pm
+===================================================================
+--- LedgerSMB/IS.pm (revision 6140)
++++ LedgerSMB/IS.pm (working copy)
+@@ -929,7 +929,7 @@
+ my ( $self, $myconfig, $form ) = @_;
+ $form->all_business_units;
+ $form->{invnumber} = $form->update_defaults( $myconfig, "sinumber", $dbh )
+- unless $form->{invnumber};
++ if $form->should_update_defaults('invnumber');
+
+ my $dbh = $LedgerSMB::App_State::DBH;;
+
+Index: LedgerSMB/Tax.pm
+===================================================================
+--- LedgerSMB/Tax.pm (revision 6140)
++++ LedgerSMB/Tax.pm (working copy)
+@@ -67,6 +67,7 @@
+ if ( defined $taxaccounts2 ) {
+ next if $taxaccounts2 !~ /\b$taxaccount\b/;
+ }
++ $form->{transdate} = undef unless $form->{transdate};
+ $sth->execute($taxaccount, $form->{transdate}) || $form->dberror($query);
+ my $ref = $sth->fetchrow_hashref;
+ next unless $ref;
+Index: bin/is.pl
+===================================================================
+--- bin/is.pl (revision 6140)
++++ bin/is.pl (working copy)
+@@ -585,7 +585,7 @@
+ $employee
+ <tr>
+ <th align=right nowrap>| . $locale->text('Invoice Number') . qq|</th>
+- <td><input name="invnumber" size="20" value="$form->{invnumber}"></td>
++ <td><input name="invnumber" size="20" value="$form->{invnumber}">| . $form->sequence_dropdown('sinumber') . qq|</td>
+ </tr>
+ <tr>
+ <th align=right nowrap>| . $locale->text('Order Number') . qq|</th>
+Index: LedgerSMB/IR.pm
+===================================================================
+--- LedgerSMB/IR.pm (revision 6140)
++++ LedgerSMB/IR.pm (working copy)
+@@ -85,7 +85,7 @@
+ }
+ my $dbh = $LedgerSMB::App_State::DBH;
+ $form->{invnumber} = $form->update_defaults( $myconfig, "vinumber", $dbh )
+- unless $form->{invnumber};
++ if $form->should_update_defaults('invnumber');
+
+ for ( 1 .. $form->{rowcount} ) {
+ $form->{"qty_$_"} *= -1 if $form->{reverse};
+Index: bin/ir.pl
+===================================================================
+--- bin/ir.pl (revision 6163)
++++ bin/ir.pl (working copy)
+@@ -544,7 +544,8 @@
+ <table>
+ <tr>
+ <th align=right nowrap>| . $locale->text('Invoice Number') . qq|</th>
+- <td><input name=invnumber size=20 value="$form->{invnumber}"></td>
++ <td><input name=invnumber size=20 value="$form->{invnumber}">
++ | . $form->sequence_dropdown('vinumber') . qq|</td>
+ </tr>
+ <tr>
+ <th align=right nowrap>| . $locale->text('Order Number') . qq|</th>
+Index: LedgerSMB/GL.pm
+===================================================================
+--- LedgerSMB/GL.pm (revision 6140)
++++ LedgerSMB/GL.pm (working copy)
+@@ -69,7 +69,7 @@
+ my ( $self, $myconfig, $form, $locale) = @_;
+ $form->all_business_units;
+ $form->{reference} = $form->update_defaults( $myconfig, 'glnumber', $dbh )
+- unless $form->{reference};
++ if $form->should_update_defaults('glnumber');
+ my $null;
+ my $project_id;
+ my $department_id;
+Index: LedgerSMB/Scripts/configuration.pm
+===================================================================
+--- LedgerSMB/Scripts/configuration.pm (revision 6156)
++++ LedgerSMB/Scripts/configuration.pm (working copy)
+@@ -93,7 +93,6 @@
+ { name => 'glnumber', label => $locale->text('GL Reference Number') },
+ { name => 'sinumber',
+ label => $locale->text('Sales Invoice/AR Transaction Number'), },
+- { name => 'vclimit', label => $locale->text('Max per dropdown') },
+ { name => 'sonumber', label => $locale->text('Sales Order Number') },
+ { name => 'vinumber' ,
+ label => $locale->text('Vendor Invoice/AP Transaction Number')},
+@@ -111,6 +110,7 @@
+ type => 'SELECT_ONE',
+ label => $locale->text('Widgit Themes') },
+ { name => 'check_prefix', label => $locale->text('Check Prefix') },
++ { name => 'vclimit', label => $locale->text('Max per dropdown') },
+ { name => 'check_max_invoices',
+ label => $locale->text('Max Invoices per Check Stub') },
+ { name => 'decimal_places',
+Index: UI/journal/journal_entry.html
+===================================================================
+--- UI/journal/journal_entry.html (revision 6140)
++++ UI/journal/journal_entry.html (working copy)
+@@ -25,8 +25,17 @@
+ size = "20",
+ class = 'reference'
+ id = "ref_1"
+- } ?>
+-
++ };
++ IF form.sequences;
++ form.sequences.unshift({});
++ PROCESS select element_data = {
++ name = 'setting_sequence'
++ default_values = [form.setting_sequence]
++ options = form.sequences
++ text_attr = 'label'
++ value_attr = 'label'
++ };
++ END; ?>
+ </td>
+ <th align="right"><?lsmb text('Date') ?></th>
+ <td>
+Index: bin/gl.pl
+===================================================================
+--- bin/gl.pl (revision 6140)
++++ bin/gl.pl (working copy)
+@@ -49,6 +49,7 @@
+ use LedgerSMB::GL;
+ use LedgerSMB::PE;
+ use LedgerSMB::Template;
++use LedgerSMB::Setting::Sequence;
+
+ require 'bin/bridge.pl'; # needed for voucher dispatches
+ require "bin/arap.pl";
+@@ -164,7 +165,6 @@
+ unless $form->{callback};
+
+ &create_links;
+- $form->{reference} = $form->update_defaults(\%myconfig, 'glnumber');
+ if (!$form->{rowcount}){
+ $form->{rowcount} = ( $form->{transfer} ) ? 3 : 9;
+ }
+@@ -182,6 +182,8 @@
+ {
+ #Add General Ledger Transaction
+ $form->all_business_units($form->{transdate}, undef, 'GL');
++ @{$form->{sequences}} = LedgerSMB::Setting::Sequence->list('glnumber')
++ unless $form->{id};
+ $form->close_form;
+ $form->open_form;
+ $form->{dbh}->commit;
+Index: LedgerSMB/OE.pm
+===================================================================
+--- LedgerSMB/OE.pm (revision 6140)
++++ LedgerSMB/OE.pm (working copy)
+@@ -131,7 +131,7 @@
+ }
+ $form->{"$ordnumber"} =
+ $form->update_defaults( $myconfig, $numberfld, $dbh )
+- unless $form->{"$ordnumber"};
++ if $form->should_update_defaults($form->{"$ordnumber"});
+
+
+
+Index: bin/oe.pl
+===================================================================
+--- bin/oe.pl (revision 6167)
++++ bin/oe.pl (working copy)
+@@ -334,7 +334,29 @@
+
+ sub form_header {
+
++ my $ordnumber;
++ my $numberfld;
++ if ( $form->{type} =~ /_order$/ ) {
++ $quotation = "0";
++ $ordnumber = "ordnumber";
++ if ($form->{vc} eq 'customer'){
++ $numberfld = "sonumber";
++ } else {
++ $numberfld = "ponumber";
++ }
++ }
++ else {
++ $quotation = "1";
++ $ordnumber = "quonumber";
++ if ( $form->{vc} eq 'customer' ) {
++ $numberfld = "sqnumber";
++ } else {
++ $numberfld = "rfqnumber";
++ }
++ }
+ $form->{nextsub} = 'update';
++
++ $sequences = $form->sequence_dropdown($numberfld) unless $form->{id};
+
+ $checkedopen = ( $form->{closed} ) ? "" : "checked";
+ $checkedclosed = ( $form->{closed} ) ? "checked" : "";
+@@ -430,7 +452,8 @@
+ $ordnumber = qq|
+ <tr class="ordnumber-row">
+ <th width=70% align=right nowrap>| . $locale->text('Order Number') . qq|</th>
+- <td><input name=ordnumber size=20 value="$form->{ordnumber}"></td>
++ <td><input name=ordnumber size=20 value="$form->{ordnumber}">
++ $sequences</td>
+ <input type=hidden name=quonumber value="$form->{quonumber}">
+ </tr>
+ <tr class="transdate-row">
+@@ -499,7 +522,8 @@
+ <th width=70% align=right nowrap>|
+ . $locale->text('Quotation Number')
+ . qq|</th>
+- <td><input name=quonumber size=20 value="$form->{quonumber}"></td>
++ <td><input name=quonumber size=20 value="$form->{quonumber}">
++ $sequences</td>
+ <input type=hidden name=ordnumber value="$form->{ordnumber}">
+ </tr>
+ |;
+@@ -508,7 +532,8 @@
+ $ordnumber = qq|
+ <tr class="rfqnumber-row">
+ <th width=70% align=right nowrap>| . $locale->text('RFQ Number') . qq|</th>
+- <td><input name=quonumber size=20 value="$form->{quonumber}"></td>
++ <td><input name=quonumber size=20 value="$form->{quonumber}">
++ $sequences</td>
+ <input type=hidden name=ordnumber value="$form->{ordnumber}">
+ </tr>
+ |;
+Index: LedgerSMB/IC.pm
+===================================================================
+--- LedgerSMB/IC.pm (revision 6140)
++++ LedgerSMB/IC.pm (working copy)
+@@ -252,7 +252,7 @@
+ my $nocommit=1;
+ $form->{partnumber} =
+ $form->update_defaults( $myconfig, "partnumber", $dbh,$nocommit)
+- if !$form->{partnumber};
++ if $form->should_update_defaults('partnumber');
+
+ ( $form->{inventory_accno} ) = split( /--/, $form->{IC_inventory} );
+ ( $form->{expense_accno} ) = split( /--/, $form->{IC_expense} );
+Index: bin/ic.pl
+===================================================================
+--- bin/ic.pl (revision 6140)
++++ bin/ic.pl (working copy)
+@@ -771,7 +771,8 @@
+ <th align=left>$group</th>
+ </tr>
+ <tr valign=top>
+- <td><input name=partnumber value="$form->{partnumber}" size=20></td>
++ <td><input name=partnumber value="$form->{partnumber}" size=20>
++ | . $form->sequence_dropdown('partnumber') . qq| </td>
+ <td>$description</td>
+ <td>$partsgroup</td>
+ </tr>
Copied: addons/1.3/sequences/trunk/scripts/configuration.pl (from rev 6173, trunk/LedgerSMB/Scripts/configuration.pm)
===================================================================
--- addons/1.3/sequences/trunk/scripts/configuration.pl (rev 0)
+++ addons/1.3/sequences/trunk/scripts/configuration.pl 2013-10-24 04:32:45 UTC (rev 6175)
@@ -0,0 +1,343 @@
+=head1 NAME
+
+LedgerSMB::Scripts::configuration - Configuration Workflows for LedgerSMB
+
+=head1 SYNPOPSIS
+
+LedgerSMB::Scripts::configuration->can('action')->($request);
+
+=cut
+package LedgerSMB::Scripts::configuration;
+use LedgerSMB::Setting;
+use LedgerSMB::Setting::Sequence;
+use LedgerSMB::AM; # To be removed, only for template directories right now
+use strict;
+use warnings;
+
+my $locale = $LedgerSMB::App_State::Locale;
+
+our @default_settings = (
+ { title => $locale->text('Company Information'),
+ items => [
+ { name => 'company_name', label => $locale->text('Company Name') },
+ { name => 'company_address',
+ type => 'TEXTAREA',
+ label => $locale->text('Company Address') },
+ { name => 'company_phone', label => $locale->text('Company Phone') },
+ { name => 'company_fax', label => $locale->text('Company Fax') },
+ { name => 'businessnumber', label => $locale->text('Business Number') },
+ { name => 'default_email_to',
+ label => $locale->text('Default Email To') },
+ { name => 'default_email_cc',
+ label => $locale->text('Default Email CC') },
+ { name => 'default_email_bcc',
+ label => $locale->text('Default Email BCC') },
+ { name => 'default_email_from',
+ label => $locale->text('Default Email From') },
+ { name => 'company_sales_tax_id',
+ label => $locale->text('Company Sales Tax ID') },
+ { name => 'company_license_number',
+ label => $locale->text('Company License Number') },
+ { name => 'curr',
+ label => $locale->text('Currencies (colon-separated)')},
+ { name => 'weightunit', label => $locale->text('Weight Unit') },
+ { name => 'default_country',
+ label => $locale->text('Default Country'),
+ type => 'SELECT_ONE', },
+ { name => 'default_language',
+ label => $locale->text('Default Language'),
+ type => 'SELECT_ONE', },
+ { name => 'templates',
+ type => 'SELECT_ONE',
+ label => $locale->text('Template Set'), },
+ { name => 'format',
+ type => 'SELECT_ONE',
+ label => $locale->text('Default Format'), },
+ ] },
+ { title => $locale->text('Security Settings'),
+ items => [
+ { name => 'password_duration',
+ label => $locale->text('Password Duration') },
+ { name => 'session_timeout',
+ label => $locale->text('Session Timeout'), },
+ { name => 'auto_logout',
+ label => $locale->text('Automatically Logout'),
+ type => 'YES_NO', },
+ { name => 'separate_duties',
+ label => $locale->text('Separate Duties'),
+ type => 'YES_NO', },
+ { name => 'lock_description',
+ label => 'Lock Item Description',
+ type => 'YES_NO', },
+ ] },
+ { title => $locale->text('Default Accounts'),
+ items => [
+ { name => 'inventory_accno_id',
+ type => 'SELECT_ONE',
+ label => $locale->text('Inventory'), },
+ { name => 'income_accno_id',
+ type => 'SELECT_ONE',
+ label => $locale->text('Income'), },
+ { name => 'expense_accno_id',
+ type => 'SELECT_ONE',
+ label => $locale->text('Cost of Goods Sold'), },
+ { name => 'fxgain_accno_id',
+ type => 'SELECT_ONE',
+ label => $locale->text('Foreign Exchange Gain') },
+ { name => 'fxloss_accno_id',
+ type => 'SELECT_ONE',
+ label => $locale->text('Foreign Exchange Loss') },
+ ] },
+ { title => $locale->text('Next in Sequence'),
+ items => [
+ { name => 'glnumber', label => $locale->text('GL Reference Number') },
+ { name => 'sinumber',
+ label => $locale->text('Sales Invoice/AR Transaction Number'), },
+ { name => 'sonumber', label => $locale->text('Sales Order Number') },
+ { name => 'sqnumber', label => $locale->text('Sales Quotation Number') },
+ { name => 'vinumber' ,
+ label => $locale->text('Vendor Invoice/AP Transaction Number')},
+ { name => 'ponumber', label => $locale->text('Purchase Order Number') },
+ { name => 'rfqnumber', label => $locale->text('RFQ Number') },
+ { name => 'partnumber', label => $locale->text('Part Number') },
+ { name => 'projectnumber', label => $locale->text('Business Unit Number') },
+ { name => 'employeenumber', label => $locale->text('Employee Number') },
+ { name => 'customernumber', label => $locale->text('Customer Number') },
+ { name => 'vendornumber', label => $locale->text('Vendor Number') },
+ ] },
+ { title => $locale->text('Misc Settings'),
+ items => [
+ { name => 'dojo_theme',
+ type => 'SELECT_ONE',
+ label => $locale->text('Widgit Themes') },
+ { name => 'check_prefix', label => $locale->text('Check Prefix') },
+ { name => 'vclimit', label => $locale->text('Max per dropdown') },
+ { name => 'check_max_invoices',
+ label => $locale->text('Max Invoices per Check Stub') },
+ { name => 'decimal_places',
+ label => $locale->text('Decimal Places for Money') },
+ { name => 'template_immages',
+ label => $locale->text('Images in Templates'),
+ type => 'YES_NO', },
+ ] },
+);
+
+=head1 METHODS/ACTIONS
+
+=over
+
+=item defaults_screen
+
+Shows the defaults screen
+
+=cut
+
+sub defaults_screen{
+ my ($request) = @_;
+ my $setting_handle = LedgerSMB::Setting->new({base => $request});
+ my @defaults;
+ for my $dg (@default_settings){
+ for my $tb (@{$dg->{items}}){
+ push @defaults, $tb->{name};
+ }
+ }
+ for my $skey (@defaults){
+ $request->{$skey} = $setting_handle->get($skey);
+ }
+ my @country_list = $request->call_procedure(
+ procname => 'location_list_country'
+ );
+ unshift @country_list, {}
+ if ! defined $request->{default_country};
+
+ my @language_code_list =
+ $request->call_procedure(procname=> 'person__list_languages');
+ unshift @language_code_list, {}
+ if ! defined $request->{default_language};
+
+ my $expense_accounts = $setting_handle->accounts_by_link('IC_expense');
+ my $income_accounts = $setting_handle->accounts_by_link('IC_income');
+ my $fx_loss_accounts = $setting_handle->accounts_by_link('FX_loss');
+ my $fx_gain_accounts = $setting_handle->accounts_by_link('FX_gain');
+ my $inventory_accounts = $setting_handle->accounts_by_link('IC');
+
+ unshift @$expense_accounts, {}
+ if ! defined $request->{expense_accno_id};
+ unshift @$income_accounts, {}
+ if ! defined $request->{income_accno_id};
+ unshift @$fx_loss_accounts, {}
+ if ! defined $request->{fxloss_accno_id};
+ unshift @$fx_gain_accounts, {}
+ if ! defined $request->{fxgain_accno_id};
+ unshift @$inventory_accounts, {}
+ if ! defined $request->{inventory_accno_id};
+
+ my %selects = (
+ 'dojo_theme' => {name => 'dojo_theme', # TODO autodetect
+ options => [{text => 'Claro', value => 'claro'},
+ {text => 'Nihilo', value => 'nihilo'},
+ {text => 'Soria', value => 'soria'},
+ {text => 'Tundra', value => 'tundra'},],
+ default_values => [$request->{dojo_theme}]},
+ 'fxloss_accno_id' => {name => 'fxloss_accno_id',
+ options => $fx_loss_accounts,
+ text_attr => 'text',
+ value_attr => 'id'},
+ 'fxgain_accno_id' => {name => 'fxgain_accno_id',
+ text_attr => 'text',
+ options => $fx_gain_accounts,
+ value_attr => 'id'},
+ 'expense_accno_id' => {name => 'expense_accno_id',
+ options => $expense_accounts,
+ text_attr => 'text',
+ value_attr => 'id'},
+ 'income_accno_id' => {name => 'income_accno_id',
+ options => $income_accounts,
+ text_attr => 'text',
+ value_attr => 'id'},
+ 'inventory_accno_id' => {name => 'inventory_accno_id',
+ options => $inventory_accounts,
+ text_attr => 'text',
+ value_attr => 'id'},
+ 'default_country' => {name => 'default_country',
+ options => ..hidden..,
+ default_values => [$request->{'default_country'}],
+ text_attr => 'name',
+ value_attr => 'id',
+ },
+ 'default_language' => {name => 'default_language',
+ options => ..hidden..,
+ default_values => [$request->{'default_language'}],
+ text_attr => 'description',
+ value_attr => 'code',
+ },
+ 'templates' => {name => 'templates',
+ options => _get_template_directories(),
+ text_attr => 'text',
+ default_values => [$request->{'templates'}],
+ value_attr => 'value'
+ },
+ 'format' => {name => 'format',
+ text_attr => 'text',
+ value_attr => 'value',
+ default_values => [$request->{'format'}],
+ options => [{ text => 'HTML',
+ value => 'html'},
+ { text => 'PDF',
+ value => 'pdf'},
+ { text => 'Postscript',
+ value => 'postscript'}]
+ }
+ );
+ my $template = LedgerSMB::Template->new_UI(
+ user => $LedgerSMB::App_State::User,
+ locale => $locale,
+ template => 'Configuration/settings');
+ $template->render({
+ form => $request,
+ # hiddens => \%hiddens,
+ selects => \%selects,
+ default_settings => ..hidden..,
+ });
+}
+
+=item sequence_screen
+
+No inputs expected or used
+
+=cut
+
+sub sequence_screen {
+ my ($request) = @_;
+ @{$request->{sequence_list}} = LedgerSMB::Setting::Sequence->list();
+ for my $subset (@default_settings){
+ $request->{setting_keys} = $subset->{items}
+ if $subset->{title} eq $locale->text('Next in Sequence');
+ }
+ my $count = 0;
+ for my $item (@{$request->{setting_keys}}){
+ for my $blacklist (qw(customernumber vendornumber employeenumber)){
+ delete $request->{setting_keys}->[$count] if $item->{name} eq $blacklist;
+ }
+ ++$count;
+ }
+ LedgerSMB::Template->new_UI(
+ user => $LedgerSMB::App_State::User,
+ locale => $locale,
+ template => 'Configuration/sequence')->render($request);
+
+}
+
+=item save_defaults
+
+Saves settings from the defaults screen
+
+=cut
+
+sub save_defaults {
+ my ($request) = @_;
+ if (!$request->is_allowed_role(
+ {allowed_roles => ['system_settings_change'] })
+ ){
+ die $locale->text('Access Denied');
+ }
+ my $setting_handle = LedgerSMB::Setting->new({base => $request});
+ my @defaults;
+ for my $dg (@default_settings){
+ for my $tb (@{$dg->{items}}){
+ push @defaults, $tb->{name};
+ }
+ }
+ for my $skey (@defaults){
+ $request->{$skey} =~ s/--.*$// if $skey =~ /accno_id/;
+ $setting_handle->set($skey, $request->{$skey});
+ }
+ defaults_screen($request);
+}
+
+=item _get_template_directories
+
+Returns set of template directories available.
+
+=cut
+
+sub _get_template_directories {
+ my $subdircount = 0;
+ my @dirarray;
+ opendir ( DIR, $LedgerSMB::Sysconfig::templates) || die $locale->text("Error while opening directory: [_1]", "./".$LedgerSMB::Sysconfig::templates);
+ while( my $name = readdir(DIR)){
+ next if ($name =~ /\./);
+ if (-d $LedgerSMB::Sysconfig::templates.'/'.$name) {
+ push @dirarray, {text => $name, value => $name};
+ }
+ }
+ closedir(DIR);
+ return ..hidden..;
+}
+
+sub save_sequences {
+ my ($request) = @_;
+ for my $count (1 .. $request->{count}){
+ if ($request->{"save_$count"}){
+ my %shash;
+ for my $key (qw(accept_input setting_key label prefix sequence suffix)){
+ $shash{$key} = $request->{"${key}_$count"};
+ }
+ my $sequence = LedgerSMB::Setting::Sequence->new(%shash);
+ $sequence->save;
+ }
+ }
+ sequence_screen($request);
+}
+
+=back
+
+=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
+
+1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
------------------------------------------------------------------------------
October Webinars: Code for Performance
Free Intel webinars can help you accelerate application performance.
Explore tips for MPI, OpenMP, advanced profiling, and more. Get the most from
the latest Intel processors and coprocessors. See abstracts and register >
http://pubads.g.doubleclick.net/gampad/clk?id=60135991&iu=/4140/ostg.clktrk
_______________________________________________
Ledger-smb-commits mailing list
..hidden..
https://lists.sourceforge.net/lists/listinfo/ledger-smb-commits