summaryrefslogtreecommitdiff
path: root/utils
diff options
context:
space:
mode:
authoreinhverfr <einhverfr@4979c152-3d1c-0410-bac9-87ea11338e46>2007-04-12 20:46:20 +0000
committereinhverfr <einhverfr@4979c152-3d1c-0410-bac9-87ea11338e46>2007-04-12 20:46:20 +0000
commitdf073d6e09c0f87fb2e88cc215ace843a5851d4a (patch)
tree1c15ce909d3e0353b21bbd909e6720fd485a3a53 /utils
parent65458125b8f3814fd6ef4d07b55ab69f62f5a528 (diff)
Formatting with Perltidy
git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/branches/1.2@1068 4979c152-3d1c-0410-bac9-87ea11338e46
Diffstat (limited to 'utils')
-rw-r--r--utils/cli/ledgersmb_cli.pl132
-rwxr-xr-xutils/devel/find-use36
-rw-r--r--utils/notify_short/config.pl8
-rw-r--r--utils/notify_short/listener.pl46
-rwxr-xr-xutils/pos/directnet.pl17
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;