← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:56:49 2010

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
2222.86ms419msClass::DBI::Pg::::set_up_tableClass::DBI::Pg::set_up_table
4211.46ms53.6msClass::DBI::Pg::::pg_versionClass::DBI::Pg::pg_version
1632143µs143µsClass::DBI::Pg::::CORE:matchClass::DBI::Pg::CORE:match (opcode)
0000s0sClass::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
1package Class::DBI::Pg;
2
33110µs126µsuse strict;
# spent 26µs making 1 call to strict::import
417µsrequire Class::DBI;
53112µs10suse base 'Class::DBI';
# spent 282ms making 1 call to base::import, recursion: max depth 2, time 282ms
631.12ms1141µsuse vars qw($VERSION);
# spent 141µs making 1 call to vars::import
7
8114µ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 {
11802.29ms 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
19139µs2580µs my $sth = $dbh->prepare(<<"SQL");
# spent 580µs making 2 calls to DBI::db::prepare, avg 290µs/call
20SELECT indkey FROM ${catalog}pg_index
21WHERE indisprimary=true AND indrelid=(
22SELECT oid FROM ${catalog}pg_class
23WHERE relname = ?)
24SQL
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
301442µs2575µs $sth = $dbh->prepare(<<"SQL");
# spent 575µs making 2 calls to DBI::db::prepare, avg 288µs/call
31SELECT a.attname, a.attnum
32FROM ${catalog}pg_class c, ${catalog}pg_attribute a
33WHERE c.relname = ?
34 AND a.attnum > 0 AND a.attrelid = c.oid
35ORDER BY a.attnum
36SQL
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)
431457µs2606µs $sth = $dbh->prepare(<<"SQL");
# spent 606µs making 2 calls to DBI::db::prepare, avg 303µs/call
44SELECT adsrc FROM ${catalog}pg_attrdef
45WHERE
46adrelid=(SELECT oid FROM ${catalog}pg_class WHERE relname=?)
47SQL
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 if ($nextval_str) {
55 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 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 {
87361.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
91180µs41.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
106Class::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
118Class::DBI::Pg automate the setup of Class::DBI columns and primary key
119for Postgres.
120
121select Postgres system catalog and find out all columns, primary key and
122SERIAL type column.
123
124create 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
133setup 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
142This 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
159Declares the Class::DBI class specified by TABLENAME
160
161=head2 pg_version
162
163Returns the postgres version that you are currently using.
164
165=head1 AUTHOR
166
167Daisuke Maki C<dmaki@cpan.org>
168
169=head1 AUTHOR EMERITUS
170
171Sebastian Riedel, C<sri@oook.de>
172IKEBE Tomohiro, C<ikebe@edge.co.jp>
173
174=head1 LICENSE
175
176This library is free software; you can redistribute it and/or modify it under
177the same terms as Perl itself.
178
179=head1 SEE ALSO
180
181L<Class::DBI> L<Class::DBI::mysql> L<DBD::Pg>
182
183=cut
184
1851;
# 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