diff options
Diffstat (limited to 'utils')
| -rw-r--r-- | utils/cli/ledgersmb_cli.pl | 132 | ||||
| -rwxr-xr-x | utils/devel/find-use | 36 | ||||
| -rw-r--r-- | utils/notify_short/config.pl | 8 | ||||
| -rw-r--r-- | utils/notify_short/listener.pl | 46 | ||||
| -rwxr-xr-x | utils/pos/directnet.pl | 17 |
5 files changed, 124 insertions, 115 deletions
diff --git a/utils/cli/ledgersmb_cli.pl b/utils/cli/ledgersmb_cli.pl index 67a1b8f4..69143520 100644 --- a/utils/cli/ledgersmb_cli.pl +++ b/utils/cli/ledgersmb_cli.pl @@ -4,15 +4,15 @@ # LedgerSMB Command-line script host # # -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used -# with permission. It is released under the GNU General Public License -# Version 2 or, at your option, any later version. See COPYRIGHT file for +# with permission. It is released under the GNU General Public License +# Version 2 or, at your option, any later version. See COPYRIGHT file for # details. # # This is a simple wrapper that allows you to write simple scripts with LSMB @@ -83,9 +83,10 @@ $syntax = << '_END_SYNTAX_'; _END_SYNTAX_ - $::RD_HINT = 1; - $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error - $::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.` +$::RD_HINT = 1; +$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error +$::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.` + #$::RD_TRACE = 1; my @loopstack; my $loopindex; @@ -95,96 +96,99 @@ my @control_stack; push @loopstack, $form; sub assignval { - my ($key, $value) = @_; - if ($key =~ /^ENV:/i){ - $ENV{$key} = $value; - } else { - %{$loopstack[$#loopstack - 1]}->{$key} = $value; - } + my ( $key, $value ) = @_; + if ( $key =~ /^ENV:/i ) { + $ENV{$key} = $value; + } + else { + %{ $loopstack[ $#loopstack - 1 ] }->{$key} = $value; + } } sub expression { - shift; - my ($lhs,$op,$rhs) = @_; - $lhs = $VARIABLE{$lhs} if $lhs=~/[^-+0-9]/; - return eval "$lhs $op $rhs"; + shift; + my ( $lhs, $op, $rhs ) = @_; + $lhs = $VARIABLE{$lhs} if $lhs =~ /[^-+0-9]/; + return eval "$lhs $op $rhs"; } sub call { - my ($call, $argstr) = @_; - $argstr =~ s/form/\\\%\$form/; - $argstr =~ s/user/\\\%myconfig/; - my @args = split /,\s/, $argstr; - eval "$call($argstr);\n" || print STDERR $@ . "\n"; + my ( $call, $argstr ) = @_; + $argstr =~ s/form/\\\%\$form/; + $argstr =~ s/user/\\\%myconfig/; + my @args = split /,\s/, $argstr; + eval "$call($argstr);\n" || print STDERR $@ . "\n"; } sub call_and_assign { - my $key = pop; - $stackref->{key} = call(@_); + my $key = pop; + $stackref->{key} = call(@_); } sub push_loop { - my $key = shift; - my $is_hash = 0; - if (ref($stackref->{$key}) =~ /HASH/){ - $is_hash = 1; - } elsif (ref ($stackref->{$key}) !~ /ARRAY/){ - print STDERR "Warning: Must loop through array or hash."; - } - push @loopstack, \$stackref->{$key}; - push @controlstack, - { "key" => $key, - 'index' => 0, - 'linenum' => $#linestack, - is_hash => $is_hash }; + my $key = shift; + my $is_hash = 0; + if ( ref( $stackref->{$key} ) =~ /HASH/ ) { + $is_hash = 1; + } + elsif ( ref( $stackref->{$key} ) !~ /ARRAY/ ) { + print STDERR "Warning: Must loop through array or hash."; + } + push @loopstack, \$stackref->{$key}; + push @controlstack, + { + "key" => $key, + 'index' => 0, + 'linenum' => $#linestack, + is_hash => $is_hash + }; } sub pop_loop { - pop @loopstack; - $stackref = \$loopstack[$#loopstack]; + pop @loopstack; + $stackref = \$loopstack[$#loopstack]; } sub if_handler { - my $key = shift; - if (!$stackref->{$key}){ - $if_count = 1; - } + my $key = shift; + if ( !$stackref->{$key} ) { + $if_count = 1; + } } sub login { - $myconfig = new LedgerSMB::User("$form->{login}"); - $form->db_init($myconfig); + $myconfig = new LedgerSMB::User("$form->{login}"); + $form->db_init($myconfig); } sub load_mod { - my $mod = shift; - $mod =~ s/::/\//; - require "$mod.pm";; + my $mod = shift; + $mod =~ s/::/\//; + require "$mod.pm"; } my $scriptparse = new Parse::RecDescent($syntax); - $loopindex = 0; my @linestack; -while ($line = <>){ - push @linestack, $line; - if ($if_count){ - if ($line =~ /^\s*IF\s/){ - ++$if_count; - } - if ($line =~ /^(\s*FI\s*|\s*END\s+IF\s*)$/){ - --$if_count; - } - } - next if ($if_count); - $line =~ s/#.*$//; # strip comments - $scriptparse->startrule($line); +while ( $line = <> ) { + push @linestack, $line; + if ($if_count) { + if ( $line =~ /^\s*IF\s/ ) { + ++$if_count; + } + if ( $line =~ /^(\s*FI\s*|\s*END\s+IF\s*)$/ ) { + --$if_count; + } + } + next if ($if_count); + $line =~ s/#.*$//; # strip comments + $scriptparse->startrule($line); } delete $form->{password}; -for (keys %$form){ - print "$_ = $form->{$_}\n"; +for ( keys %$form ) { + print "$_ = $form->{$_}\n"; } diff --git a/utils/devel/find-use b/utils/devel/find-use index fa2014f0..c90ddcc5 100755 --- a/utils/devel/find-use +++ b/utils/devel/find-use @@ -1,4 +1,5 @@ #!/usr/bin/perl -w + =head1 NAME find-use @@ -27,7 +28,6 @@ Distributed under the terms of the LedgerSMB code. =cut - use strict; use warnings; @@ -35,25 +35,29 @@ open GREP, "grep -r '^use ' . |"; use Module::CoreList; my %uselines; -while(<GREP>) { - next if /LedgerSMB::/; - next if /use warnings/; - next if /use strict/; - next if /use vars/; - chomp; - my ($file, $useline) = m/^([^:]+):use\s(.*?)$/; - $uselines{$useline}||=[]; - push @{$uselines{$useline}}, $file; +while (<GREP>) { + next if /LedgerSMB::/; + next if /use warnings/; + next if /use strict/; + next if /use vars/; + chomp; + my ( $file, $useline ) = m/^([^:]+):use\s(.*?)$/; + $uselines{$useline} ||= []; + push @{ $uselines{$useline} }, $file; } my %modules; -foreach my $useline (keys %uselines) { +foreach my $useline ( keys %uselines ) { - my ($module) = grep { $_ } $useline =~ /(?:base ['"]([a-z:]+)|([a-z:]+)(?:\s|;))/i; - my $version = Module::CoreList->first_release($module); - $modules{$module} = $version||0; + my ($module) = + grep { $_ } $useline =~ /(?:base ['"]([a-z:]+)|([a-z:]+)(?:\s|;))/i; + my $version = Module::CoreList->first_release($module); + $modules{$module} = $version || 0; } -foreach my $mod (sort { $modules{$a} == 0 ? -1 : $modules{$b} == 0 ? 1 : 0 or $a cmp $b } keys %modules) { - printf "%2.6f : %s\n", $modules{$mod}, $mod; +foreach my $mod ( + sort { $modules{$a} == 0 ? -1 : $modules{$b} == 0 ? 1 : 0 or $a cmp $b } + keys %modules ) +{ + printf "%2.6f : %s\n", $modules{$mod}, $mod; } diff --git a/utils/notify_short/config.pl b/utils/notify_short/config.pl index bd37bed1..cddda1e0 100644 --- a/utils/notify_short/config.pl +++ b/utils/notify_short/config.pl @@ -1,13 +1,12 @@ #!/usr/bin/perl -use vars qw($email_to $cc_to $email_from $sendmail $database $db_user - $db_passwd $template_head $template_foot); +use vars qw($email_to $cc_to $email_from $sendmail $database $db_user + $db_passwd $template_head $template_foot); # The address to send the mail to. On UNIX systems, multiple addresses can be # separated by a space. $email_to = 'manager@example'; - # The email address this email is from: $email_from = 'noreply@example'; @@ -28,8 +27,7 @@ $cycle_delay = 60; # The password for the db user: $db_passwd = "mypasswd"; -$template_top = -"From: $email_from +$template_top = "From: $email_from Subject: Parts Short Notice Hi. This is the SL-Short listener. You are receiving this message because diff --git a/utils/notify_short/listener.pl b/utils/notify_short/listener.pl index dae23d0a..05b5afd0 100644 --- a/utils/notify_short/listener.pl +++ b/utils/notify_short/listener.pl @@ -7,40 +7,46 @@ # By Chris Travers, Metatron Technology Consulting # chris@metatrontech.com # -# Released under the GNU GPL v2.0 or later. See included GPL.txt for more +# Released under the GNU GPL v2.0 or later. See included GPL.txt for more # information. require "config.pl"; use DBI; my $dsn = "dbi:Pg:dbname=$database"; -my $dbh = DBI->connect($dsn, $db_user, $db_passwd, - { AutoCommit => 1, - PrintError => 0, - RaiseError => 1, } +my $dbh = DBI->connect( + $dsn, $db_user, + $db_passwd, + { + AutoCommit => 1, + PrintError => 0, + RaiseError => 1, + } ); my $sth; $dbh->do("LISTEN parts_short"); -while (1){ # loop infinitely - if ($dbh->func ('pg_notifies')){ - &on_notify; - } - sleep $cycle_delay; +while (1) { # loop infinitely + if ( $dbh->func('pg_notifies') ) { + &on_notify; + } + sleep $cycle_delay; } + sub on_notify { - open (MAIL, "|-", $sendmail); - $sth = $dbh->prepare(" + open( MAIL, "|-", $sendmail ); + $sth = $dbh->prepare( " SELECT partnumber, description, onhand, rop FROM parts WHERE onhand <= rop - "); - $sth->execute; - print MAIL $template_top; - while (($partnumber, $description, $avail, $rop) = $sth->fetchrow_array){ - write MAIL; - } - print MAIL $template_foot; - close MAIL; + " ); + $sth->execute; + print MAIL $template_top; + while ( ( $partnumber, $description, $avail, $rop ) = $sth->fetchrow_array ) + { + write MAIL; + } + print MAIL $template_foot; + close MAIL; } diff --git a/utils/pos/directnet.pl b/utils/pos/directnet.pl index 3bdd2e51..efe4de0a 100755 --- a/utils/pos/directnet.pl +++ b/utils/pos/directnet.pl @@ -1,19 +1,16 @@ #!/usr/bin/perl -($host, $proto, $port) = @ARGV; +( $host, $proto, $port ) = @ARGV; -socket(SOCK, 2, 1, getprotobynumber($proto)); +socket( SOCK, 2, 1, getprotobynumber($proto) ); -$dest=pack( - 's n a4 x8', 2, $port, - pack('CCCC', split(/\./, $host)) -); +$dest = pack( 's n a4 x8', 2, $port, pack( 'CCCC', split( /\./, $host ) ) ); -connect (SOCK, $dest); +connect( SOCK, $dest ); -open ('STD', '-'); -while ($line = <STD>){ - print SOCK $line; +open( 'STD', '-' ); +while ( $line = <STD> ) { + print SOCK $line; } close STD; close SOCK; |