Merge pull request #8136 from ehuelsmann/cleanup/old-code-to-workflows

Move some functionality from 'workflow scripts' to workflows

lib/LedgerSMB/Workflow/Action/TransactionApprove.pm

@@ -0,0 +1,54 @@
+package LedgerSMB::Workflow::Action::TransactionApprove;
+
+=head1 NAME
+
+LedgerSMB::Workflow::Action::TransactionApprove - Approve draft AR/AP/GL transactions
+
+=head1 SYNOPSIS
+
+  # action configuration
+  <actions>
+    <action name="Approve" class="LedgerSMB::Workflow::Action::TransactionApprove"
+            history-text="Some description for the workflow history" />
+  </actions>
+
+
+=head1 DESCRIPTION
+
+This module implements an action which approves a transaction, synchronizing the
+workflow state to the C< transactions > table.
+
+=head1 METHODS
+
+=cut
+
+
+use v5.36;
+use warnings;
+use parent qw( LedgerSMB::Workflow::Action::Null );
+
+=head2 execute($wf)
+
+Implements the C<Workflow::Action> protocol.
+
+=cut
+
+sub execute( $self, $wf ) {
+    # When the persister finds a true-ish 'approved' value,
+    # it syncs that state between the context and the 'transactions' table
+    $wf->context->param( 'approved', 1 );
+
+    $self->SUPER::execute($wf);
+    return;
+}
+
+1;
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (C) 2024 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.
+

lib/LedgerSMB/Workflow/Action/TransactionDelete.pm

@@ -0,0 +1,54 @@
+package LedgerSMB::Workflow::Action::TransactionDelete;
+
+=head1 NAME
+
+LedgerSMB::Workflow::Action::TransactionDelete - Delete draft AR/AP/GL transactions
+
+=head1 SYNOPSIS
+
+  # action configuration
+  <actions>
+    <action name="Delete" class="LedgerSMB::Workflow::Action::TransactionDelete"
+            history-text="Some description for the workflow history" />
+  </actions>
+
+
+=head1 DESCRIPTION
+
+This module implements an action which deletes a transaction, removing it from
+the C< transactions > table.
+
+=head1 METHODS
+
+=cut
+
+
+use v5.36;
+use warnings;
+use parent qw( LedgerSMB::Workflow::Action::Null );
+
+=head2 execute($wf)
+
+Implements the C<Workflow::Action> protocol.
+
+=cut
+
+sub execute( $self, $wf ) {
+    # When the persister finds a true-ish 'deleted' value,
+    # it syncs that state between the context and the 'transactions' table
+    $wf->context->param( 'deleted', 1 );
+
+    $self->SUPER::execute($wf);
+    return;
+}
+
+1;
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (C) 2024 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.
+

lib/LedgerSMB/Workflow/Persister/JournalEntry.pm

@@ -16,11 +16,9 @@ expected to declare the email table and fields as "ExtraData" configuration.
 =cut
 
 
+use v5.36;
 use warnings;
-use strict;
-use base qw( LedgerSMB::Workflow::Persister::ExtraData );
-
-use Carp qw(croak);
+use parent qw( LedgerSMB::Workflow::Persister::ExtraData );
 
 =head2 create_workflow
 
@@ -32,19 +30,63 @@ associated.
 
 =cut
 
-sub create_workflow {
-    my ($self, $wf) = @_;
+sub create_workflow($self, $wf) {
+    my $id  = $self->SUPER::create_workflow( $wf );
+    my $ctx = $wf->context;
+    $ctx->param( "_old_$_", $ctx->param( $_ ) )
+        for (qw( approved deleted ));
+
+    return $id;
+}
+
+=head2 update_workflow
+
+Saves the workflow and synchronizes the workflow state to the
+C< transactions > table using the context parameter C< id >.
 
-    return $self->SUPER::create_workflow( $wf );
+=cut
 
+sub update_workflow($self, $wf) {
+    my $ctx = $wf->context;
+
+    if ($ctx->param( 'approved' )
+        and not $ctx->param( '_old_approved' )) {
+        my $dbh = $self->handle;
+        my $sth = $dbh->prepare(<<~'SQL')
+              select draft_approve(id)
+                from transactions
+               where id = ? and not approved
+              SQL
+            or die $dbh->errstr;
+        $sth->execute($wf->context->param('id'))
+            or die $sth->errstr;
+        $sth->finish;
+    }
+    elsif ($ctx->param( 'deleted' )) {
+        my $dbh = $self->handle;
+        my $sth = $dbh->prepare(<<~'SQL')
+              select draft_delete(id)
+                from transactions
+               where id = ?
+              SQL
+            or die $dbh->errstr;
+        $sth->execute($wf->context->param('id'))
+            or die $sth->errstr;
+        $sth->finish;
+    }
+
+    $self->SUPER::update_workflow( $wf );
+    $ctx->param( "_old_$_", $ctx->param( $_ ) )
+        for (qw( approved deleted ));
+    return;
 }
 
 
 1;
 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright (C) 2020 The LedgerSMB Core Team
+Copyright (C) 2020-2024 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

old/bin/aa.pl

@@ -149,7 +149,6 @@ sub del {
         ->fetch_workflow( 'AR/AP', $form->{workflow_id} );
     $wf->execute_action( 'del' );
 
-    $form->call_procedure(funcname=>'draft_delete', args => [ $form->{id} ]);
     $form->info($locale->text('Draft deleted'));
 }
 

old/bin/gl.pl

@@ -112,14 +112,14 @@ sub save_info {
 }
 
 sub approve {
-    $form->call_procedure(funcname=>'draft_approve', args => [ $form->{id} ]);
-    if ($form->{workflow_id}) {
-        my $wf = $form->{_wire}->get('workflows')->fetch_workflow(
-            'GL', $form->{workflow_id}
-            );
-        $wf->context->param( transdate => $form->{transdate} );
-        $wf->execute_action( $form->{__action} );
-    }
+    my $wf = $form->{_wire}->get('workflows')->fetch_workflow(
+        'GL', $form->{workflow_id}
+        );
+    die q|No workflow found to approve| unless $wf;
+
+    $wf->context->param( transdate => $form->{transdate} );
+    $wf->execute_action( $form->{__action} );
+
     if ($form->{callback}){
         print "Location: $form->{callback}\n";
         print "Status: 302 Found\n\n";
@@ -745,16 +745,13 @@ sub post {
 }
 
 sub del {
-    $form->error($locale->text('Cannot delete posted transaction'))
-       if ($form->{approved});
-    if ($form->{workflow_id}) {
-        my $wf = $form->{_wire}->get('workflows')->fetch_workflow(
-            'GL', $form->{workflow_id}
-            );
-        $wf->context->param( transdate => $form->{transdate} );
-        $wf->execute_action( $form->{__action} );
-    }
-    $form->call_procedure(funcname=>'draft_delete', args => [ $form->{id} ]);
+    my $wf = $form->{_wire}->get('workflows')->fetch_workflow(
+        'GL', $form->{workflow_id}
+        );
+    die 'No workflow to mark deleted' unless $wf;
+    $wf->context->param( transdate => $form->{transdate} );
+    $wf->execute_action( $form->{__action} );
+
     delete $form->{id};
     delete $form->{reference};
     new();

old/bin/io.pl

@@ -132,12 +132,11 @@ sub _calc_taxes {
 }
 
 sub approve {
-    $form->update_invnumber;
-    $form->call_procedure(funcname=>'draft_approve', args => [ $form->{id} ]);
-
     my $wf = $form->{_wire}->get('workflows')
         ->fetch_workflow( 'AR/AP', $form->{workflow_id} );
-    $wf->execute_action( 'approve' ) if $wf;
+    die 'No workflow found to approve' unless $wf;
+
+    $wf->execute_action( 'approve' );
     edit();
 }
 

old/bin/ir.pl

@@ -135,7 +135,6 @@ sub del {
         ->fetch_workflow( 'AR/AP', $form->{workflow_id} );
     $wf->execute_action( 'del' );
 
-    $form->call_procedure(funcname=>'draft_delete', args => [ $form->{id} ]);
     $form->info($locale->text('Draft deleted'));
 }
 

old/bin/is.pl

@@ -128,7 +128,6 @@ sub del {
         ->fetch_workflow( 'AR/AP', $form->{workflow_id} );
     $wf->execute_action( 'del' );
 
-    $form->call_procedure(funcname=>'draft_delete', args => [ $form->{id} ]);
     $form->info($locale->text('Draft deleted'));
 }
 

old/lib/LedgerSMB/Form.pm

@@ -3003,24 +3003,6 @@ sub should_update_defaults {
     return 0;
 }
 
-=item $form->update_invnumber
-
-If invnumber is not set, updates it.  Used when gapless numbering is in effect
-
-=cut
-
-sub update_invnumber {
-    my $self = shift;
-    my $query =
-        q|update ar
-             set invnumber = setting_increment('sinumber')
-           where id = ? and invnumber is null|;
-    $self->{dbh}->do($query,
-                     {},
-                     $self->{id})
-        or $self->dberror($query);
-}
-
 =item $form->db_prepare_vars(var1, var2, ..., varI<n>)
 
 Undefines $form->{varI<m>}, 1 <= I<m> <= I<n>, iff $form-<{varI<m> is both

sql/modules/Drafts.sql

@@ -84,9 +84,13 @@ begin
         SELECT table_name into t_table FROM transactions where id = in_id;
 
         IF (t_table = 'ar') THEN
-                PERFORM cogs__add_for_ar_line(id) FROM invoice
-                  WHERE trans_id = in_id;
-                UPDATE ar set approved = true where id = in_id;
+          PERFORM cogs__add_for_ar_line(id)
+             FROM invoice
+            WHERE trans_id = in_id;
+          UPDATE ar
+             set invnumber = setting_increment('sinumber')
+           WHERE id = in_id AND invnumber is null;
+          UPDATE ar set approved = true WHERE id = in_id;
         ELSIF (t_table = 'ap') THEN
                 PERFORM cogs__add_for_ap_line(id) FROM invoice
                   WHERE trans_id = in_id;

workflows/ar-ap.actions.xml

@@ -39,7 +39,7 @@ TODO! Check workflow when 'separate duties' is false!
           doing="Posting..."
           done="Posted"
           history-text="Posted"
-          class="LedgerSMB::Workflow::Action::Null" />
+          class="LedgerSMB::Workflow::Action::TransactionApprove" />
   <action name="batch-approve"
           group="main"
           ui="none"
@@ -158,7 +158,7 @@ TODO! Check workflow when 'separate duties' is false!
           order="21"
           text="Delete"
           short-help="Remove draft transaction"
-          class="LedgerSMB::Workflow::Action::Null" />
+          class="LedgerSMB::Workflow::Action::TransactionDelete" />
 
   <!-- these actions do not have a matching button in is.pl or ir.pl or aa.pl -->
   <action name="print_and_save"

workflows/gl.actions.xml

@@ -39,7 +39,7 @@ TODO! Check workflow when 'separate duties' is false!
           doing="Posting..."
           done="Posted"
           history-text="Posted"
-          class="LedgerSMB::Workflow::Action::Null" />
+          class="LedgerSMB::Workflow::Action::TransactionApprove" />
   <!--action name="batch-approve"
           group="main"
           ui="none"
@@ -115,7 +115,7 @@ TODO! Check workflow when 'separate duties' is false!
           doing="Deleting..."
           done="Deleted"
           short-help="Remove draft transaction"
-          class="LedgerSMB::Workflow::Action::Null" />
+          class="LedgerSMB::Workflow::Action::TransactionDelete" />
 
   <action name="save_as_new"
           group="main"

xt/perlcriticrc

@@ -2,11 +2,11 @@
 
 # Use these themes:
 
-#  lsmb         -- includes all themes we want to use 
+#  lsmb         -- includes all themes we want to use
 #  lsmb_new     -- themes enforced on 'new' code
 #  lsmb_old     -- themes enforced on 'old' code; subset of lsmb_new
 #  lsmb_tests   -- themes enforced on tests
-#  lsmb_wip     -- themes we are trying to use on 'new' code 
+#  lsmb_wip     -- themes we are trying to use on 'new' code
 #  lsmb_old_wip -- themes we are trying to use on 'old' code, subset of lsmb_wip
 
 #  lsmb_reject   -- explicitly rejected themes
@@ -77,7 +77,8 @@ pager = less
 [Subroutines::ProhibitReturnSort]
     set_themes = lsmb lsmb_new lsmb_tests
 [Subroutines::ProhibitSubroutinePrototypes]
-    set_themes = lsmb lsmb_new lsmb_tests
+    # Unfortunately, subroutine prototypes are confused with signatures
+    set_themes = lsmb_reject
 [TestingAndDebugging::ProhibitProlongedStrictureOverride]
     set_themes = lsmb lsmb_new lsmb_tests
 [TestingAndDebugging::RequireUseStrict]
@@ -156,7 +157,7 @@ pager = less
     set_themes = lsmb lsmb_wip lsmb_old_wip
 [InputOutput::RequireCheckedSyscalls]
     set_themes = lsmb lsmb_new lsmb_old_wip lsmb_tests
-    functions = open close 
+    functions = open close
 
 [RegularExpressions::ProhibitCaptureWithoutTest]
     set_themes = lsmb lsmb_wip lsmb_old_wip
@@ -178,7 +179,7 @@ pager = less
 
 # Rejected policies
 
-# It is easier to lookup $^D than remember 
+# It is easier to lookup $^D than remember
 # if $DEBUGGING is an application var.
 #[Variables::ProhibitPunctuationVars]