Doing a simple Perltidy commit so that I can evaluate differences between the branches and make sure patches are up to date

git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@1103 4979c152-3d1c-0410-bac9-87ea11338e46

8 files changed, 285 insertions, 234 deletions

diff --git a/LedgerSMB/RESTXML/Document/Base.pm b/LedgerSMB/RESTXML/Document/Base.pm
index e8feaa96..986b4148 100644
--- a/LedgerSMB/RESTXML/Document/Base.pm
+++ b/LedgerSMB/RESTXML/Document/Base.pm
@@ -5,26 +5,27 @@ use XML::Twig;
 use LedgerSMB::Log;
 use Carp;
 
-sub handle_post { 
-	my ($self, $args) = @_;
+sub handle_post {
+    my ( $self, $args ) = @_;
 
-	return $args->{handler}->unsupported('the POST method is not implemented.');
+    return $args->{handler}->unsupported('the POST method is not implemented.');
 }
 
-sub handle_put { 
-	my ($self, $args) = @_;
-	return $self->{handler}->unsupported('the PUT method is not implemented.');
+sub handle_put {
+    my ( $self, $args ) = @_;
+    return $self->{handler}->unsupported('the PUT method is not implemented.');
 }
 
 sub handle_delete {
-	my ($self, $args) = @_;
-	return $self->{handler}->unsupported('the DELETE method is not implemented.');
+    my ( $self, $args ) = @_;
+    return $self->{handler}
+      ->unsupported('the DELETE method is not implemented.');
 }
 
 sub handle_get {
-	my ($self, $args) = @_;
+    my ( $self, $args ) = @_;
 
-	return $self->{handler}->unsupported('the GET method is not implemented.');
+    return $self->{handler}->unsupported('the GET method is not implemented.');
 }
 
 =head3 hash_to_twig
@@ -45,18 +46,25 @@ nodes at once.
 
 =cut
 
-sub hash_to_twig { 
-	my ($self, $args) = @_;
-
-	my $hash = $args->{hash} || croak "Need a hash to convert to use hash_to_twig";
-	my $name = $args->{name} || croak "Need a root element name to use hash_to_twig";
-	my @keyorder = keys %$hash;	
-	
-	@keyorder = sort @keyorder unless defined($args->{sort}) and $args->{sort} == 0;
-
-	return XML::Twig::Elt->new($name,$args->{root_attr}||{}, map  {
-		XML::Twig::Elt->new($_, {'#CDATA'=>1}, $hash->{$_})
-	} @keyorder );
+sub hash_to_twig {
+    my ( $self, $args ) = @_;
+
+    my $hash = $args->{hash}
+      || croak "Need a hash to convert to use hash_to_twig";
+    my $name = $args->{name}
+      || croak "Need a root element name to use hash_to_twig";
+    my @keyorder = keys %$hash;
+
+    @keyorder = sort @keyorder
+      unless defined( $args->{sort} )
+      and $args->{sort} == 0;
+
+    return XML::Twig::Elt->new(
+        $name,
+        $args->{root_attr} || {},
+        map { XML::Twig::Elt->new( $_, { '#CDATA' => 1 }, $hash->{$_} ) }
+          @keyorder
+    );
 }
 
 1;
diff --git a/LedgerSMB/RESTXML/Document/Customer.pm b/LedgerSMB/RESTXML/Document/Customer.pm
index 3a494965..b2e19753 100644
--- a/LedgerSMB/RESTXML/Document/Customer.pm
+++ b/LedgerSMB/RESTXML/Document/Customer.pm
@@ -3,21 +3,22 @@ use strict;
 use warnings;
 use base qw(LedgerSMB::RESTXML::Document::Base);
 
+sub handle_get {
+    my ( $self, $args ) = @_;
+    my $user    = $args->{user};
+    my $dbh     = $args->{dbh};
+    my $handler = $args->{handler};
 
-sub handle_get { 
-	my ($self, $args) = @_;	
-	my $user = $args->{user};
-	my $dbh = $args->{dbh};
-	my $handler = $args->{handler};
+    my $res = $dbh->selectrow_hashref( q{SELECT * from customer where id = ?},
+        undef, $args->{args}[0] );
 
-	my $res = $dbh->selectrow_hashref(q{SELECT * from customer where id = ?}, undef, $args->{args}[0]);
-
-	if(!$res) { 
-		$handler->not_found("No customer with the id $args->{args}[0] found");
-	} else { 
-		$handler->respond($self->hash_to_twig({name=>'Customer',hash=>$res}));
-	}
+    if ( !$res ) {
+        $handler->not_found("No customer with the id $args->{args}[0] found");
+    }
+    else {
+        $handler->respond(
+            $self->hash_to_twig( { name => 'Customer', hash => $res } ) );
+    }
 }
 
-
 1;
diff --git a/LedgerSMB/RESTXML/Document/Customer_Search.pm b/LedgerSMB/RESTXML/Document/Customer_Search.pm
index 7456f9d3..9f2fb3d6 100644
--- a/LedgerSMB/RESTXML/Document/Customer_Search.pm
+++ b/LedgerSMB/RESTXML/Document/Customer_Search.pm
@@ -4,43 +4,58 @@ use warnings;
 use base qw(LedgerSMB::RESTXML::Document::Base);
 use LedgerSMB::Log;
 
-sub handle_get { 
-	my ($self, $args) = @_;	
-	my $user = $args->{user};
-	my $dbh = $args->{dbh};
-	my $handler = $args->{handler};
-	
-	my $query = $handler->read_query();
-
-	my %terms;
-
-	for my $field ($query->param()) { 
-		# TODO: BIG GAPING HOLE HERE.
-		$terms{$field} = $query->param($field);	
-	}
-
-	if($terms{_keyword}) { 
-		%terms = (
-				name=>$terms{_keyword},
-				customernumber=>$terms{_keyword},
-				contact=>$terms{_keyword}
-		);
-	}
-	my $sql = 'SELECT id,name,phone,customernumber FROM customer WHERE '.join(' OR ',map { "$_ like ?" } sort keys %terms);
-	
-		
-	my $res = $dbh->prepare($sql);
-
-	$res->execute(map { "$terms{$_}\%" } sort keys %terms) or return $handler->error($dbh->errstr);
-
-	my @rows;
-	my $row;
-	push @rows, $row while $row = $res->fetchrow_hashref();
-	
-	$res->finish();
-	
-	$handler->respond(XML::Twig::Elt->new('Customer_Search_Response',{'xmlns:xlink'=>"http://www.w3.org/1999/xlink"},map {  
-			$self->hash_to_twig({name=>'Customer',root_attr=>{'xlink:href'=>"Customer/$_->{id}"}, hash=>$_});			
-		} @rows));
+sub handle_get {
+    my ( $self, $args ) = @_;
+    my $user    = $args->{user};
+    my $dbh     = $args->{dbh};
+    my $handler = $args->{handler};
+
+    my $query = $handler->read_query();
+
+    my %terms;
+
+    for my $field ( $query->param() ) {
+
+        # TODO: BIG GAPING HOLE HERE.
+        $terms{$field} = $query->param($field);
+    }
+
+    if ( $terms{_keyword} ) {
+        %terms = (
+            name           => $terms{_keyword},
+            customernumber => $terms{_keyword},
+            contact        => $terms{_keyword}
+        );
+    }
+    my $sql =
+      'SELECT id,name,phone,customernumber FROM customer WHERE '
+      . join( ' OR ', map { "$_ like ?" } sort keys %terms );
+
+    my $res = $dbh->prepare($sql);
+
+    $res->execute( map { "$terms{$_}\%" } sort keys %terms )
+      or return $handler->error( $dbh->errstr );
+
+    my @rows;
+    my $row;
+    push @rows, $row while $row = $res->fetchrow_hashref();
+
+    $res->finish();
+
+    $handler->respond(
+        XML::Twig::Elt->new(
+            'Customer_Search_Response',
+            { 'xmlns:xlink' => "http://www.w3.org/1999/xlink" },
+            map {
+                $self->hash_to_twig(
+                    {
+                        name      => 'Customer',
+                        root_attr => { 'xlink:href' => "Customer/$_->{id}" },
+                        hash      => $_
+                    }
+                );
+              } @rows
+        )
+    );
 }
 1;
diff --git a/LedgerSMB/RESTXML/Document/Part.pm b/LedgerSMB/RESTXML/Document/Part.pm
index 072f9b80..97394494 100644
--- a/LedgerSMB/RESTXML/Document/Part.pm
+++ b/LedgerSMB/RESTXML/Document/Part.pm
@@ -3,21 +3,22 @@ use strict;
 use warnings;
 use base qw(LedgerSMB::RESTXML::Document::Base);
 
+sub handle_get {
+    my ( $self, $args ) = @_;
+    my $user    = $args->{user};
+    my $dbh     = $args->{dbh};
+    my $handler = $args->{handler};
 
-sub handle_get { 
-	my ($self, $args) = @_;	
-	my $user = $args->{user};
-	my $dbh = $args->{dbh};
-	my $handler = $args->{handler};
+    my $res = $dbh->selectrow_hashref( q{SELECT * from part where id = ?},
+        undef, $args->{args}[0] );
 
-	my $res = $dbh->selectrow_hashref(q{SELECT * from part where id = ?}, undef, $args->{args}[0]);
-
-	if(!$res) { 
-		$handler->not_found("No part with the id $args->{args}[0] found");
-	} else { 
-		$handler->respond($self->hash_to_twig({name=>'Customer',hash=>$res}));
-	}
+    if ( !$res ) {
+        $handler->not_found("No part with the id $args->{args}[0] found");
+    }
+    else {
+        $handler->respond(
+            $self->hash_to_twig( { name => 'Customer', hash => $res } ) );
+    }
 }
 
-
 1;
diff --git a/LedgerSMB/RESTXML/Document/Part_Search.pm b/LedgerSMB/RESTXML/Document/Part_Search.pm
index 927c67c0..9339dcc2 100644
--- a/LedgerSMB/RESTXML/Document/Part_Search.pm
+++ b/LedgerSMB/RESTXML/Document/Part_Search.pm
@@ -4,42 +4,57 @@ use warnings;
 use base qw(LedgerSMB::RESTXML::Document::Base);
 use LedgerSMB::Log;
 
-sub handle_get { 
-	my ($self, $args) = @_;	
-	my $user = $args->{user};
-	my $dbh = $args->{dbh};
-	my $handler = $args->{handler};
-	
-	my $query = $handler->read_query();
-
-	my %terms;
-
-	for my $field ($query->param()) { 
-		# TODO: BIG GAPING HOLE HERE.
-		$terms{$field} = $query->param($field);	
-	}
-
-	if($terms{_keyword}) { 
-		%terms = (
-				description=>$terms{_keyword},
-				partnumber=>$terms{_keyword},
-		);
-	}
-	my $sql = 'SELECT id,description,partnumber FROM parts WHERE '.join(' OR ',map { "$_ like ?" } sort keys %terms);
-	
-		
-	my $res = $dbh->prepare($sql);
-
-	$res->execute(map { "$terms{$_}\%" } sort keys %terms) or return $handler->error($dbh->errstr);
-
-	my @rows;
-	my $row;
-	push @rows, $row while $row = $res->fetchrow_hashref();
-	
-	$res->finish();
-	
-	$handler->respond(XML::Twig::Elt->new('Part_Search_Response',{'xmlns:xlink'=>"http://www.w3.org/1999/xlink"},map {  
-			$self->hash_to_twig({name=>'Part',root_attr=>{'xlink:href'=>"Part/$_->{id}"}, hash=>$_});			
-		} @rows));
+sub handle_get {
+    my ( $self, $args ) = @_;
+    my $user    = $args->{user};
+    my $dbh     = $args->{dbh};
+    my $handler = $args->{handler};
+
+    my $query = $handler->read_query();
+
+    my %terms;
+
+    for my $field ( $query->param() ) {
+
+        # TODO: BIG GAPING HOLE HERE.
+        $terms{$field} = $query->param($field);
+    }
+
+    if ( $terms{_keyword} ) {
+        %terms = (
+            description => $terms{_keyword},
+            partnumber  => $terms{_keyword},
+        );
+    }
+    my $sql =
+      'SELECT id,description,partnumber FROM parts WHERE '
+      . join( ' OR ', map { "$_ like ?" } sort keys %terms );
+
+    my $res = $dbh->prepare($sql);
+
+    $res->execute( map { "$terms{$_}\%" } sort keys %terms )
+      or return $handler->error( $dbh->errstr );
+
+    my @rows;
+    my $row;
+    push @rows, $row while $row = $res->fetchrow_hashref();
+
+    $res->finish();
+
+    $handler->respond(
+        XML::Twig::Elt->new(
+            'Part_Search_Response',
+            { 'xmlns:xlink' => "http://www.w3.org/1999/xlink" },
+            map {
+                $self->hash_to_twig(
+                    {
+                        name      => 'Part',
+                        root_attr => { 'xlink:href' => "Part/$_->{id}" },
+                        hash      => $_
+                    }
+                );
+              } @rows
+        )
+    );
 }
 1;
diff --git a/LedgerSMB/RESTXML/Document/SalesOrder.pm b/LedgerSMB/RESTXML/Document/SalesOrder.pm
index acb4d5aa..b2f96256 100644
--- a/LedgerSMB/RESTXML/Document/SalesOrder.pm
+++ b/LedgerSMB/RESTXML/Document/SalesOrder.pm
@@ -3,15 +3,12 @@ use strict;
 use warnings;
 use base qw(LedgerSMB::RESTXML::Document::Base);
 
+sub handle_get {
+    my ( $self, $args ) = @_;
 
-
-sub handle_get { 
-	my ($self, $args) = @_;	
-	
-	print "Content-type: text/html\n\n";
-	print "It still works";
+    print "Content-type: text/html\n\n";
+    print "It still works";
 
 }
 
-
 1;
diff --git a/LedgerSMB/RESTXML/Document/Session.pm b/LedgerSMB/RESTXML/Document/Session.pm
index 1db36502..ed99b06b 100644
--- a/LedgerSMB/RESTXML/Document/Session.pm
+++ b/LedgerSMB/RESTXML/Document/Session.pm
@@ -16,18 +16,15 @@ use strict;
 use warnings;
 use base qw(LedgerSMB::RESTXML::Document::Base);
 
-
-sub handle_get { 
-	my ($self, $args) = @_;	
-
+sub handle_get {
+    my ( $self, $args ) = @_;
 
 }
 
-sub handle_post { 
-	my ($self, $args) = @_;
-	print "Content-type: text/html\n\nhi";
-	
-}
+sub handle_post {
+    my ( $self, $args ) = @_;
+    print "Content-type: text/html\n\nhi";
 
+}
 
 1;
diff --git a/LedgerSMB/RESTXML/Handler.pm b/LedgerSMB/RESTXML/Handler.pm
index 006c2ead..0939da7f 100644
--- a/LedgerSMB/RESTXML/Handler.pm
+++ b/LedgerSMB/RESTXML/Handler.pm
@@ -17,61 +17,73 @@ CGI_handle is the gateway for the RESTful lsmb API.
 
 =cut
 
-sub cgi_handle { 
-	my $self = shift;
-	
-	my $method = $ENV{REQUEST_METHOD};
-	my $pathinfo = $ENV{PATH_INFO};
-	
-	#pull off the leading slash, we need it in the form document/arguments/foo
-	$pathinfo =~ s#^/##;
-	
-
-	my $function = 'handle_'.lc($method);
-	my ($user, $module, @args) = split	'/',$pathinfo;
-	$user  = LedgerSMB::User->fetch_config($user);	
-	
-	my $dbh = $self->connect_db($user);	
-
-	# non-word characters are forbidden, usually a sign of someone being sneaky.
-	$module =~ s#\W##;
-	
-	my $document_module = $self->try_to_load($module);
-
-	if($document_module) { 
-		if($document_module->can($function)) { 
-			my $returnValue = $document_module->$function({dbh=>$dbh, args=>\@args, handler=>$self, user=>$user});	
-
-			#return $self->return_serialized_response($returnValue);
-
-		} else { 
-			return $self->unsupported("$module cannot handle method $method");
-		}
-	} else { 
-		return $self->not_found("Could not find a handler for document type $module: <pre>$@</pre>");
-	}
+sub cgi_handle {
+    my $self = shift;
+
+    my $method   = $ENV{REQUEST_METHOD};
+    my $pathinfo = $ENV{PATH_INFO};
+
+    #pull off the leading slash, we need it in the form document/arguments/foo
+    $pathinfo =~ s#^/##;
+
+    my $function = 'handle_' . lc($method);
+    my ( $user, $module, @args ) = split '/', $pathinfo;
+    $user = LedgerSMB::User->fetch_config($user);
+
+    my $dbh = $self->connect_db($user);
+
+    # non-word characters are forbidden, usually a sign of someone being sneaky.
+    $module =~ s#\W##;
+
+    my $document_module = $self->try_to_load($module);
+
+    if ($document_module) {
+        if ( $document_module->can($function) ) {
+            my $returnValue = $document_module->$function(
+                {
+                    dbh     => $dbh,
+                    args    => \@args,
+                    handler => $self,
+                    user    => $user
+                }
+            );
+
+            #return $self->return_serialized_response($returnValue);
+
+        }
+        else {
+            return $self->unsupported("$module cannot handle method $method");
+        }
+    }
+    else {
+        return $self->not_found(
+            "Could not find a handler for document type $module: <pre>$@</pre>"
+        );
+    }
 }
 
-sub cgi_report_error { 
-	my $self = shift;
-	my $message = shift;
-	my $code = shift||500;
-	
-	print "Status: $code\n";
-	print "Content-Type: text/html\n\n";
-	print "<html><body>\n";
-	print "<h1>REST API error</h1>";
-	print "<blockquote>$message</blockquote>";
-	print "</body></html>";
+sub cgi_report_error {
+    my $self    = shift;
+    my $message = shift;
+    my $code    = shift || 500;
+
+    print "Status: $code\n";
+    print "Content-Type: text/html\n\n";
+    print "<html><body>\n";
+    print "<h1>REST API error</h1>";
+    print "<blockquote>$message</blockquote>";
+    print "</body></html>";
 }
-sub cgi_read_query { 
-	my $self = shift;
-	
-	use CGI;
-	my $cgi = CGI->new();
 
-	return $cgi;
+sub cgi_read_query {
+    my $self = shift;
+
+    use CGI;
+    my $cgi = CGI->new();
+
+    return $cgi;
 }
+
 # ------------------------------------------------------------------------------------------------------------------------
 
 =head3 try_to_load
@@ -83,20 +95,21 @@ document to try to load.  returns a blessed anonymous hashref if the module
 
 =cut
 
-sub try_to_load { 
-	my $self = shift;
-	my $module = shift;
+sub try_to_load {
+    my $self   = shift;
+    my $module = shift;
 
-	eval qq{ 
+    eval qq{ 
 		use LedgerSMB::RESTXML::Document::$module;
 	};
-	if($@) { 
-		warn "Cannot load $module: $@" unless $@ =~ /Can't locate LedgerSMB\//i;
-
-		return undef;
-	} else { 
-		return bless {}, "LedgerSMB::RESTXML::Document::$module";
-	} 
+    if ($@) {
+        warn "Cannot load $module: $@" unless $@ =~ /Can't locate LedgerSMB\//i;
+
+        return undef;
+    }
+    else {
+        return bless {}, "LedgerSMB::RESTXML::Document::$module";
+    }
 }
 
 =head3 connect_db
@@ -105,67 +118,71 @@ Given  a user's config, returns a database connection handle.
 
 =cut
 
-sub connect_db { 
-	my ($self, $myconfig) = @_;
+sub connect_db {
+    my ( $self, $myconfig ) = @_;
 
-	my $dbh = DBI->connect(
-			$myconfig->{dbconnect}, $myconfig->{dbuser},
-			$myconfig->{dbpasswd})
-		or carp "Error connecting to the db :$DBI::errstr";
+    my $dbh = DBI->connect( $myconfig->{dbconnect},
+        $myconfig->{dbuser}, $myconfig->{dbpasswd} )
+      or carp "Error connecting to the db :$DBI::errstr";
 
-	return $dbh;
+    return $dbh;
 }
 
 # lets see how far XML::Simple can take us.
 use XML::Simple;
 use Scalar::Util qw(blessed);
 
-sub return_serialized_response { 
-	my ($self, $response) = @_;
+sub return_serialized_response {
+    my ( $self, $response ) = @_;
 
-	print "Content-type: text/xml\n\n";
+    print "Content-type: text/xml\n\n";
 
-	if(blessed $response && $response->isa('XML::Twig::Elt')) { 
-			print qq{<?xml version="1.0"?>\n};
-			print $response->sprint();
-	} else { 
-		my $xs = XML::Simple->new(NoAttr=>1,RootName=>'LedgerSMBResponse',XMLDecl=>1);
+    if ( blessed $response && $response->isa('XML::Twig::Elt') ) {
+        print qq{<?xml version="1.0"?>\n};
+        print $response->sprint();
+    }
+    else {
+        my $xs = XML::Simple->new(
+            NoAttr   => 1,
+            RootName => 'LedgerSMBResponse',
+            XMLDecl  => 1
+        );
 
-		print $xs->XMLout($response);
-	}
+        print $xs->XMLout($response);
+    }
 
-	return;
+    return;
 }
 
-sub read_query { 
-	my ($self) = @_;
+sub read_query {
+    my ($self) = @_;
 
-	# for now.	
-	return $self->cgi_read_query();
+    # for now.
+    return $self->cgi_read_query();
 }
 
 # =------------------------- POSSIBLE WAYS FOR MODULES TO RESPOND.
-sub respond { 
-	my ($self, $data) = @_;
+sub respond {
+    my ( $self, $data ) = @_;
 
-	return $self->return_serialized_response($data);
+    return $self->return_serialized_response($data);
 }
 
-sub not_found { 
-	my ($self, $message) = @_;
+sub not_found {
+    my ( $self, $message ) = @_;
 
-	$self->cgi_report_error($message,404);
+    $self->cgi_report_error( $message, 404 );
 }
 
-sub unsupported { 
-	my ($self, $message) = @_;
-	$self->cgi_report_error($message, 501)
+sub unsupported {
+    my ( $self, $message ) = @_;
+    $self->cgi_report_error( $message, 501 );
 }
 
-sub error { 
-	my ($self, $message) = @_;
+sub error {
+    my ( $self, $message ) = @_;
 
-	$self->cgi_report_error($message,500);
+    $self->cgi_report_error( $message, 500 );
 }
 
 1;