Profile of /project/perl/lib/Class/DBI/Pg.pm

File	/project/perl/lib/Class/DBI/Pg.pm
Statements Executed	131
Statement Execution Time	6.42ms

Subroutines — ordered by exclusive time
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
2	2	2	2.86ms	419ms	Class::DBI::Pg::::set_up_tableClass::DBI::Pg::set_up_table
4	2	1	1.46ms	53.6ms	Class::DBI::Pg::::pg_versionClass::DBI::Pg::pg_version
16	3	2	143µs	143µs	Class::DBI::Pg::::CORE:matchClass::DBI::Pg::CORE:match (opcode)
0	0	0	0s	0s	Class::DBI::Pg::::BEGINClass::DBI::Pg::BEGIN

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package Class::DBI::Pg;
2
3	3	110µs	1	26µs	use strict; # spent 26µs making 1 call to strict::import
4	1	7µs			require Class::DBI;
5	3	112µs	1	0s	use base 'Class::DBI'; # spent 282ms making 1 call to base::import, recursion: max depth 2, time 282ms
6	3	1.12ms	1	141µs	use vars qw($VERSION); # spent 141µs making 1 call to vars::import
7
8	1	14µs			$VERSION = '0.08';
9
10					# spent 419ms (2.86+416) within Class::DBI::Pg::set_up_table which was called 2 times, avg 209ms/call: # once (1.50ms+399ms) by main::BEGIN at line 4 of Wiki/DB/Wiki.pm # once (1.36ms+16.9ms) by Class::DBI::_require_class at line 5 of Wiki/DB/WikiCategories.pm sub set_up_table {
11	50	1.84ms			my ( $class, $table ) = @_;
12					my $dbh = $class->db_Main; # spent 138ms making 2 calls to Ima::DBI::__ANON__[Ima/DBI.pm:316], avg 69.2ms/call
13					my $catalog = "";
14					if ( $class->pg_version >= 7.3 ) { # spent 50.3ms making 2 calls to Class::DBI::Pg::pg_version, avg 25.1ms/call
15					$catalog = 'pg_catalog.';
16					}
17
18					# find primary key
19	1	39µs	2	580µs	my $sth = $dbh->prepare(<<"SQL"); # spent 580µs making 2 calls to DBI::db::prepare, avg 290µs/call
20					SELECT indkey FROM ${catalog}pg_index
21					WHERE indisprimary=true AND indrelid=(
22					SELECT oid FROM ${catalog}pg_class
23					WHERE relname = ?)
24					SQL
25					$sth->execute($table); # spent 157ms making 2 calls to DBIx::ContextualFetch::st::execute, avg 78.7ms/call
26					my %prinum = map { $_ => 1 } split ' ', $sth->fetchrow_array; # spent 35µs making 2 calls to DBI::st::fetchrow_array, avg 18µs/call
27					$sth->finish; # spent 24µs making 2 calls to DBI::st::finish, avg 12µs/call
28
29					# find all columns
30	1	442µs	2	575µs	$sth = $dbh->prepare(<<"SQL"); # spent 575µs making 2 calls to DBI::db::prepare, avg 288µs/call
31					SELECT a.attname, a.attnum
32					FROM ${catalog}pg_class c, ${catalog}pg_attribute a
33					WHERE c.relname = ?
34					AND a.attnum > 0 AND a.attrelid = c.oid
35					ORDER BY a.attnum
36					SQL
37					$sth->execute($table); # spent 44.1ms making 2 calls to DBIx::ContextualFetch::st::execute, avg 22.1ms/call
38					my $columns = $sth->fetchall_arrayref; # spent 70µs making 2 calls to DBI::st::fetchall_arrayref, avg 35µs/call
39					$sth->finish; # spent 19µs making 2 calls to DBI::st::finish, avg 10µs/call
40
41					# find SERIAL type.
42					# nextval('"table_id_seq"'::text)
43	1	457µs	2	606µs	$sth = $dbh->prepare(<<"SQL"); # spent 606µs making 2 calls to DBI::db::prepare, avg 303µs/call
44					SELECT adsrc FROM ${catalog}pg_attrdef
45					WHERE
46					adrelid=(SELECT oid FROM ${catalog}pg_class WHERE relname=?)
47					SQL
48					$sth->execute($table); # spent 3.99ms making 2 calls to DBIx::ContextualFetch::st::execute, avg 1.99ms/call
49					my ($nextval_str) = $sth->fetchrow_array; # spent 36µs making 2 calls to DBI::st::fetchrow_array, avg 18µs/call
50					$sth->finish; # spent 23µs making 2 calls to DBI::st::finish, avg 12µs/call
51
52					# the text representation for nextval() changed between 7.x and 8.x
53					my $sequence;
54	2	68µs			if ($nextval_str) {
55	2	95µs	2	3.37ms	if ($class->pg_version() >= 8.1) { # spent 3.37ms making 2 calls to Class::DBI::Pg::pg_version, avg 1.69ms/call
56					# hackish, but oh well...
57					($sequence) = # spent 37µs making 4 calls to Class::DBI::Pg::CORE:match, avg 9µs/call
58					$nextval_str =~ m!^nextval$'"?([^"']+)"?'::regclass$!i ?
59					$1 :
60					$nextval_str =~ m!^nextval$\("?([^"']+)"?'::text$?::regclass\)!i ?
61					$1 :
62					undef;
63					} else {
64					($sequence) = $nextval_str =~ m!^nextval$'"?([^"']+)"?'::text$!;
65					}
66					}
67
68					my ( @cols, @primary );
69					foreach my $col (@$columns) {
70					# skip dropped column.
71	26	281µs	8	36µs	next if $col->[0] =~ /^\.+pg\.dropped\.\d+\.+$/; # spent 36µs making 8 calls to Class::DBI::Pg::CORE:match, avg 4µs/call
72					push @cols, $col->[0];
73					next unless $prinum{ $col->[1] };
74					push @primary, $col->[0];
75					}
76					if (!@primary) {
77					require Carp;
78					Carp::croak("$table has no primary key");
79					}
80					$class->table($table); # spent 576µs making 2 calls to Class::DBI::table, avg 288µs/call
81					$class->columns( Primary => @primary ); # spent 4.99ms making 2 calls to Class::DBI::columns, avg 2.49ms/call
82					$class->columns( All => @cols ); # spent 11.0ms making 2 calls to Class::DBI::columns, avg 5.51ms/call
83					$class->sequence($sequence) if $sequence;
84					}
85
86					# spent 53.6ms (1.46+52.2) within Class::DBI::Pg::pg_version which was called 4 times, avg 13.4ms/call: # 2 times (819µs+49.4ms) by Class::DBI::Pg::set_up_table at line 14, avg 25.1ms/call # 2 times (638µs+2.73ms) by Class::DBI::Pg::set_up_table at line 55, avg 1.69ms/call sub pg_version {
87	36	1.75ms			my $class = shift;
88					my %args = @_;
89
90					my $dbh = $class->db_Main; # spent 30.6ms making 4 calls to Ima::DBI::__ANON__[Ima/DBI.pm:316], avg 7.64ms/call
91	1	80µs	4	1.29ms	my $sth = $dbh->prepare("SELECT version()"); # spent 1.29ms making 4 calls to DBI::db::prepare, avg 323µs/call
92					$sth->execute; # spent 20.1ms making 4 calls to DBIx::ContextualFetch::st::execute, avg 5.02ms/call
93					my ($ver_str) = $sth->fetchrow_array; # spent 116µs making 4 calls to DBI::st::fetchrow_array, avg 29µs/call
94					$sth->finish; # spent 55µs making 4 calls to DBI::st::finish, avg 14µs/call
95					my ($ver) = # spent 70µs making 4 calls to Class::DBI::Pg::CORE:match, avg 18µs/call
96					$args{full_version} ?
97					$ver_str =~ m/^PostgreSQL ([\d\.]{5})/ :
98					$ver_str =~ m/^PostgreSQL ([\d\.]{3})/;
99					return $ver;
100					}
101
102					__END__
103
104					=head1 NAME
105
106					Class::DBI::Pg - Class::DBI extension for Postgres
107
108					=head1 SYNOPSIS
109
110					use strict;
111					use base qw(Class::DBI::Pg);
112
113					__PACKAGE__->set_db(Main => 'dbi:Pg:dbname=dbname', 'user', 'password');
114					__PACKAGE__->set_up_table('film');
115
116					=head1 DESCRIPTION
117
118					Class::DBI::Pg automate the setup of Class::DBI columns and primary key
119					for Postgres.
120
121					select Postgres system catalog and find out all columns, primary key and
122					SERIAL type column.
123
124					create table.
125
126					CREATE TABLE cd (
127					id SERIAL NOT NULL PRIMARY KEY,
128					title TEXT,
129					artist TEXT,
130					release_date DATE
131					);
132
133					setup your class.
134
135					package CD;
136					use strict;
137					use base qw(Class::DBI::Pg);
138
139					__PACKAGE__->set_db(Main => 'dbi:Pg:dbname=db', 'user', 'password');
140					__PACKAGE__->set_up_table('cd');
141
142					This is almost the same as the following way.
143
144					package CD;
145
146					use strict;
147					use base qw(Class::DBI);
148
149					__PACKAGE__->set_db(Main => 'dbi:Pg:dbname=db', 'user', 'password');
150					__PACKAGE__->table('cd');
151					__PACKAGE__->columns(Primary => 'id');
152					__PACKAGE__->columns(All => qw(id title artist release_date));
153					__PACKAGE__->sequence('cd_id_seq');
154
155					=head1 METHODS
156
157					=head2 set_up_table TABLENAME
158
159					Declares the Class::DBI class specified by TABLENAME
160
161					=head2 pg_version
162
163					Returns the postgres version that you are currently using.
164
165					=head1 AUTHOR
166
167					Daisuke Maki C<dmaki@cpan.org>
168
169					=head1 AUTHOR EMERITUS
170
171					Sebastian Riedel, C<sri@oook.de>
172					IKEBE Tomohiro, C<ikebe@edge.co.jp>
173
174					=head1 LICENSE
175
176					This library is free software; you can redistribute it and/or modify it under
177					the same terms as Perl itself.
178
179					=head1 SEE ALSO
180
181					L<Class::DBI> L<Class::DBI::mysql> L<DBD::Pg>
182
183					=cut
184
185					1;
					# spent 143µs within Class::DBI::Pg::CORE:match which was called 16 times, avg 9µs/call: # 8 times (36µs+0s) by Class::DBI::Pg::set_up_table at line 71 of Class/DBI/Pg.pm, avg 4µs/call # 4 times (70µs+0s) by Class::DBI::Pg::pg_version at line 95 of Class/DBI/Pg.pm, avg 18µs/call # 4 times (37µs+0s) by Class::DBI::Pg::set_up_table at line 57 of Class/DBI/Pg.pm, avg 9µs/call sub Class::DBI::Pg::CORE:match; # xsub