libs/shortcuts/database.pm

## ---------------------------------------------------------------------------
##  $Id: database.pm,v 1.2 2003/04/09 07:51:11 joko Exp $
## ---------------------------------------------------------------------------
##  $Log: database.pm,v $
##  Revision 1.2  2003/04/09 07:51:11  joko
##  renamed from db.pm
##
##  Revision 1.1  2003/04/08 23:09:16  joko
##  initial commit: code from perl/libs/libdb.pm
##
## ---------------------------------------------------------------------------

=pod

=head1  Background

   Databases = Everything is sql
   Perl ~ Everything is a hash   ;-)


=cut


package shortcuts::database;

use strict;
use warnings;

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( 
  SQL_INSERT SQL_UPDATE SQL_SELECT
  hash2sql
  quotesql
  dsn2dbname
);


use constant SQL_INSERT => 10;
use constant SQL_UPDATE => 11;
use constant SQL_SELECT => 12;
use constant SQL_DELETE => 13;


use Data::Dumper;


# TODO: handle usage of "$crit" in an abstract way somehow
sub hash2sql {
  
  # the arguments
  my $table = shift;
  my $hash = shift;
  my $mode = shift;
  my $crit = shift;
  
  # our result
  my $sql;
  
  # declare commands and associated tokens
  my @command = qw( SELECT INSERT UPDATE DELETE );
  my @token = ( SQL_SELECT, SQL_INSERT, SQL_UPDATE, SQL_DELETE );
  
  # translate stringified mode to token
  my $c = 0;
  foreach (@command) {
    $mode = $token[$c] if ($mode eq 'SQL_' . $_ || $mode eq $_);
    $c++;
  }
  
  # pre-flight check: has mode been resolved into token?
  if ($mode !~ m/\d+/) {
    print __PACKAGE__ . "::hash2sql: no mode, no token, no way!", "\n";
    return;
  }

  # dispatch mode
  if ($mode == SQL_SELECT) {
    $sql = "SELECT #fields# FROM $table";
  } elsif ($mode == SQL_INSERT) {
    $sql = "INSERT INTO $table (#fields#) VALUES (#values#)";
  } elsif ($mode == SQL_UPDATE) {
    $sql = "UPDATE $table SET #fields-values#";
  } elsif ($mode == SQL_DELETE) {
    if (!$crit) {
      print __PACKAGE__ . "::hash2sql: Criteria required for mode 'SQL_DELETE' (\$crit must not be empty!).", "\n";
      return;
    }
    $sql = "DELETE FROM $table";
  }
  
  # apply filter?
  if ($mode != SQL_INSERT && $crit) {
    $sql .= " WHERE $crit" if $sql;
  }
  
  my (@fields, @values);
  foreach my $key (keys %{$hash}) {
    push @fields, $key;
    push @values, $hash->{$key};
  }

  # quote each element
  map { if (defined $_) { $_ = "'$_'" } else { $_ = "null" } } @values;
  
  my $fields = join(', ', @fields);
  my $values = join(', ', @values);
  my $fields_values = '';
  my $fc = 0;
  foreach (@fields) {
    $fields_values .= $_ . '=' . $values[$fc] . ', ';
    $fc++;
  }
  $fields_values = substr($fields_values, 0, -2);
  
  # FIXME: this should only be valid for 'SELECT' queries
  $fields ||= '*';
  
  $sql =~ s/#fields#/$fields/;
  $sql =~ s/#values#/$values/;
  $sql =~ s/#fields-values#/$fields_values/;
  
  print __PACKAGE__ . "::hash2sql: \$sql=$sql", "\n";
  
  return $sql;
}


sub quotesql {
  my $string = shift;
  if ($string) {
    $string =~ s/'/\\'/g;
  }
  return $string;
}

sub dsn2dbname {
  my $dsn = shift;
  $dsn =~ m/database=(.+?);/;
  my $database_name = $1;
  return $database_name;
}

1;
__END__
1	joko	1.1	## ---------------------------------------------------------------------------
2	joko	1.3	## $Id: database.pm,v 1.2 2003/04/09 07:51:11 joko Exp $
3	joko	1.1	## ---------------------------------------------------------------------------
4	joko	1.3	## $Log: database.pm,v $
5			## Revision 1.2 2003/04/09 07:51:11 joko
6			## renamed from db.pm
7			##
8	joko	1.1	## Revision 1.1 2003/04/08 23:09:16 joko
9			## initial commit: code from perl/libs/libdb.pm
10			##
11			## ---------------------------------------------------------------------------
12
13			=pod
14
15			=head1 Background
16
17			Databases = Everything is sql
18			Perl ~ Everything is a hash ;-)
19
20
21			=cut
22
23
24
25	joko	1.3	package shortcuts::database;
26	joko	1.1
27			use strict;
28			use warnings;
29
30			require Exporter;
31			our @ISA = qw( Exporter );
32			our @EXPORT_OK = qw(
33			SQL_INSERT SQL_UPDATE SQL_SELECT
34			hash2sql
35			quotesql
36			dsn2dbname
37			);
38
39
40			use constant SQL_INSERT => 10;
41			use constant SQL_UPDATE => 11;
42			use constant SQL_SELECT => 12;
43	joko	1.3	use constant SQL_DELETE => 13;
44	joko	1.1
45
46			use Data::Dumper;
47
48
49			# TODO: handle usage of "$crit" in an abstract way somehow
50			sub hash2sql {
51
52	joko	1.3	# the arguments
53	joko	1.1	my $table = shift;
54			my $hash = shift;
55			my $mode = shift;
56			my $crit = shift;
57
58	joko	1.3	# our result
59	joko	1.1	my $sql;
60	joko	1.3
61			# declare commands and associated tokens
62			my @command = qw( SELECT INSERT UPDATE DELETE );
63			my @token = ( SQL_SELECT, SQL_INSERT, SQL_UPDATE, SQL_DELETE );
64
65			# translate stringified mode to token
66			my $c = 0;
67			foreach (@command) {
68			$mode = $token[$c] if ($mode eq 'SQL_' . $_ \|\| $mode eq $_);
69			$c++;
70			}
71
72			# pre-flight check: has mode been resolved into token?
73			if ($mode !~ m/\d+/) {
74			print __PACKAGE__ . "::hash2sql: no mode, no token, no way!", "\n";
75			return;
76			}
77	joko	1.1
78	joko	1.3	# dispatch mode
79	joko	1.1	if ($mode == SQL_SELECT) {
80			$sql = "SELECT #fields# FROM $table";
81			} elsif ($mode == SQL_INSERT) {
82			$sql = "INSERT INTO $table (#fields#) VALUES (#values#)";
83			} elsif ($mode == SQL_UPDATE) {
84			$sql = "UPDATE $table SET #fields-values#";
85	joko	1.3	} elsif ($mode == SQL_DELETE) {
86			if (!$crit) {
87			print __PACKAGE__ . "::hash2sql: Criteria required for mode 'SQL_DELETE' (\$crit must not be empty!).", "\n";
88			return;
89			}
90			$sql = "DELETE FROM $table";
91	joko	1.1	}
92
93	joko	1.3	# apply filter?
94			if ($mode != SQL_INSERT && $crit) {
95			$sql .= " WHERE $crit" if $sql;
96	joko	1.1	}
97
98			my (@fields, @values);
99			foreach my $key (keys %{$hash}) {
100			push @fields, $key;
101			push @values, $hash->{$key};
102			}
103	joko	1.2
104	joko	1.1	# quote each element
105			map { if (defined $_) { $_ = "'$_'" } else { $_ = "null" } } @values;
106
107			my $fields = join(', ', @fields);
108			my $values = join(', ', @values);
109			my $fields_values = '';
110			my $fc = 0;
111			foreach (@fields) {
112			$fields_values .= $_ . '=' . $values[$fc] . ', ';
113			$fc++;
114			}
115			$fields_values = substr($fields_values, 0, -2);
116
117			# FIXME: this should only be valid for 'SELECT' queries
118			$fields \|\|= '*';
119
120			$sql =~ s/#fields#/$fields/;
121			$sql =~ s/#values#/$values/;
122			$sql =~ s/#fields-values#/$fields_values/;
123
124	joko	1.3	print __PACKAGE__ . "::hash2sql: \$sql=$sql", "\n";
125	joko	1.1
126			return $sql;
127			}
128
129
130			sub quotesql {
131			my $string = shift;
132			if ($string) {
133			$string =~ s/'/\\'/g;
134			}
135			return $string;
136			}
137
138			sub dsn2dbname {
139			my $dsn = shift;
140			$dsn =~ m/database=(.+?);/;
141			my $database_name = $1;
142			return $database_name;
143			}
144
145			1;
146			__END__
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26