summaryrefslogtreecommitdiff
path: root/LedgerSMB/DBObject.pm
blob: c1d36d8092cc7ccd6f2c91aa35c6e3ecc7761bf4 (plain)
  1. =head1 NAME
  2. LedgerSMB::DBObject - LedgerSMB class for building objects from db relations
  3. =head1 SYOPSIS
  4. This module creates object instances based on LedgerSMB's in-database ORM.
  5. =head1 METHODS
  6. =over
  7. =item new ($class, base => $LedgerSMB::hash)
  8. This is the base constructor for all child classes. It must be used with base
  9. argument because this is necessary for database connectivity and the like.
  10. Of course the base object can be any object that inherits LedgerSMB, so you can
  11. use any subclass of that. The per-session dbh is passed between the objects
  12. this way as is any information that is needed.
  13. =item exec_method ($self, procname => $function_name, args => \@args)
  14. =item merge ($hashref, @attrs)
  15. copies @attrs from $hashref to $self.
  16. =item set (@attrs)
  17. Copies the given key=>vars to $self. Allows for finer control of
  18. merging hashes into self.
  19. =back
  20. =head1 Copyright (C) 2007, The LedgerSMB core team.
  21. This file is licensed under the Gnu General Public License version 2, or at your
  22. option any later version. A copy of the license should have been included with
  23. your software.
  24. =cut
  25. package LedgerSMB::DBObject;
  26. use Scalar::Util;
  27. use base qw(LedgerSMB);
  28. use strict;
  29. use warnings;
  30. our $AUTOLOAD;
  31. sub AUTOLOAD {
  32. my ($self) = shift;
  33. my $type = Scalar::Util::blessed $self;
  34. $type =~ m/::(.*?)$/;
  35. $type = lc $1;
  36. $self->exec_method( funcname => "$type" . "_" . $AUTOLOAD, args => \@_);
  37. }
  38. sub new {
  39. my $class = shift @_;
  40. my %args = (ref($_[0]) eq 'HASH')? %{$_[0]}: @_;
  41. my $base = $args{base};
  42. my $mode = $args{copy};
  43. my $self = bless {}, $class;
  44. my @mergelist;
  45. if ( defined $args{merge} ){
  46. @mergelist = @{ $args{merge} };
  47. } elsif (defined $mode && ( $mode eq 'list')) {
  48. $self->error('Mergelist not set');
  49. }
  50. else {
  51. @mergelist = [];
  52. }
  53. if ( !$base->isa('LedgerSMB') ) {
  54. $self->error("Constructor called without LedgerSMB object arg");
  55. }
  56. my $attr;
  57. if (lc($mode) eq 'base'){
  58. $self->merge($base, 'dbh', '_roles');
  59. }
  60. elsif (lc($mode) eq 'list'){
  61. $self->merge($base, @mergelist);
  62. }
  63. else {
  64. $self->merge($base);
  65. }
  66. $self;
  67. }
  68. sub set_ordering {
  69. my $self = shift @_;
  70. my %args = @_;
  71. if (not defined $self->{_order_method}){
  72. $self->{_order_method} = {};
  73. }
  74. $self->{_order_method}->{$args{method}} = $args{column};
  75. }
  76. sub exec_method {
  77. my $self = shift @_;
  78. my %args = @_;
  79. my $funcname = $args{funcname};
  80. my @in_args;
  81. @in_args = @{ $args{args}} if $args{args};
  82. my @call_args;
  83. my $query = "SELECT proname, pronargs, proargnames FROM pg_proc WHERE proname = ?";
  84. my $sth = $self->{dbh}->prepare($query);
  85. $sth->execute($funcname);
  86. my $ref;
  87. $ref = $sth->fetchrow_hashref('NAME_lc');
  88. my $args = $ref->{proargnames};
  89. my @proc_args;
  90. $ref->{pronargs} = 0 unless defined $ref->{pronargs};
  91. if ($ref->{pronargs}){
  92. $args =~ s/\{(.*)\}/$1/;
  93. @proc_args = split /,/, $args if $args;
  94. }
  95. if ( !$ref ) { # no such function
  96. $self->error( "No such function: ", $funcname );
  97. die;
  98. }
  99. my $m_name = $ref->{proname};
  100. if ($args) {
  101. for my $arg (@proc_args) {
  102. if ( $arg =~ s/^in_// ) {
  103. push @call_args, $self->{$arg};
  104. }
  105. }
  106. }
  107. for (@in_args) { push @call_args, $_ } ;
  108. $self->{call_args} = \@call_args;
  109. $self->debug({file => '/tmp/dbobject'});
  110. $self->call_procedure( procname => $funcname, args => \@call_args );
  111. }
  112. sub run_custom_queries {
  113. my ( $self, $tablename, $query_type, $linenum ) = @_;
  114. my $dbh = $self->{dbh};
  115. if ( $query_type !~ /^(select|insert|update)$/i ) {
  116. # Commenting out this next bit until we figure out how the locale object
  117. # will operate. Chris
  118. #$self->error($locale->text(
  119. # "Passed incorrect query type to run_custom_queries."
  120. #));
  121. }
  122. my @rc;
  123. my %temphash;
  124. my @templist;
  125. my $did_insert;
  126. my @elements;
  127. my $query;
  128. my $ins_values;
  129. if ($linenum) {
  130. $linenum = "_$linenum";
  131. }
  132. $query_type = uc($query_type);
  133. for ( @{ $self->{custom_db_fields}{$tablename} } ) {
  134. @elements = split( /:/, $_ );
  135. push @{ $temphash{ $elements[0] } }, $elements[1];
  136. }
  137. for ( keys %temphash ) {
  138. my @data;
  139. $query = "$query_type ";
  140. if ( $query_type eq 'UPDATE' ) {
  141. $query = "DELETE FROM $_ WHERE row_id = ?";
  142. my $sth = $dbh->prepare($query);
  143. $sth->execute( $self->{ "id" . "$linenum" } )
  144. || $self->dberror($query);
  145. }
  146. elsif ( $query_type eq 'INSERT' ) {
  147. $query .= " INTO $_ (";
  148. }
  149. my $first = 1;
  150. for ( @{ $temphash{$_} } ) {
  151. $query .= "$_";
  152. if ( $query_type eq 'UPDATE' ) {
  153. $query .= '= ?';
  154. }
  155. $ins_values .= "?, ";
  156. $query .= ", ";
  157. $first = 0;
  158. if ( $query_type eq 'UPDATE' or $query_type eq 'INSERT' ) {
  159. push @data, $self->{"$_$linenum"};
  160. }
  161. }
  162. if ( $query_type ne 'INSERT' ) {
  163. $query =~ s/, $//;
  164. }
  165. if ( $query_type eq 'SELECT' ) {
  166. $query .= " FROM $_";
  167. }
  168. if ( $query_type eq 'SELECT' or $query_type eq 'UPDATE' ) {
  169. $query .= " WHERE row_id = ?";
  170. }
  171. if ( $query_type eq 'INSERT' ) {
  172. $query .= " row_id) VALUES ($ins_values ?)";
  173. }
  174. if ( $query_type eq 'SELECT' ) {
  175. push @rc, [$query];
  176. }
  177. else {
  178. unshift( @data, $query );
  179. push @rc, [@data];
  180. }
  181. }
  182. if ( $query_type eq 'INSERT' ) {
  183. for (@rc) {
  184. $query = shift( @{$_} );
  185. my $sth = $dbh->prepare($query)
  186. || $self->db_error($query);
  187. $sth->execute( @{$_}, $self->{id} )
  188. || $self->dberror($query);
  189. $sth->finish;
  190. $did_insert = 1;
  191. }
  192. }
  193. elsif ( $query_type eq 'UPDATE' ) {
  194. @rc = $self->run_custom_queries( $tablename, 'INSERT', $linenum );
  195. }
  196. elsif ( $query_type eq 'SELECT' ) {
  197. for (@rc) {
  198. $query = shift @{$_};
  199. my $sth = $self->{dbh}->prepare($query);
  200. $sth->execute( $self->{id} );
  201. my $ref = $sth->fetchrow_hashref('NAME_lc');
  202. $self->merge( $ref, keys(%$ref) );
  203. }
  204. }
  205. @rc;
  206. }
  207. sub _parse_array {
  208. my ($self, $value) = @_;
  209. my $next;
  210. my $separator;
  211. my @return_array;
  212. while ($value ne '{}') {
  213. my $next = "";
  214. my $separator = "";
  215. if ($value =~ /^\{"/){
  216. while ($next eq "" or ($next =~ /\\".$/)){
  217. $value =~ s/^\{("[^"]*".)/\{/;
  218. $next .= $1;
  219. $next =~ /(.)$/;
  220. $separator = $1;
  221. }
  222. $next =~ s/"(.*)"$separator$/$1/;
  223. } elsif ($value =~ /^{({+})/){
  224. my $open_braces = $1;
  225. my $close_braces = $open_braces;
  226. $close_braces =~ s/{/}/g;
  227. $value =~ /^{($open_braces.*$close_braces)/;
  228. $next = $1;
  229. $value =~ s/^{$next/{/;
  230. $next = $self->parse_array($next);
  231. } else {
  232. $value =~ s/^\{([^,]*)(,|\})/\{/;
  233. $next = $1;
  234. $separator = $2;
  235. }
  236. $value .= '}' if $separator eq '}';
  237. $next =~ s/\\\\/\\/g;
  238. $next =~ s/\\"/"/g;
  239. push @return_array, $next;
  240. }
  241. return @return_array;
  242. }
  243. sub set {
  244. my $self = shift @_;
  245. my %args = @_;
  246. for my $arg (keys(%args)) {
  247. $self->{$arg} = $args{$arg};
  248. }
  249. return 1;
  250. }
  251. 1;