← 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:57:06 2010

File /project/perl/lib/Class/DBI/Pg.pm
Statements Executed 127
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 {
11217µs my ( $class, $table ) = @_;
12249µs2138ms my $dbh = $class->db_Main;
# spent 138ms making 2 calls to Ima::DBI::__ANON__[Ima/DBI.pm:316], avg 69.2ms/call
13211µs my $catalog = "";
14293µs250.3ms 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
19297µ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
25238µs2157ms $sth->execute($table);
# spent 157ms making 2 calls to DBIx::ContextualFetch::st::execute, avg 78.7ms/call
262103µs235µs my %prinum = map { $_ => 1 } split ' ', $sth->fetchrow_array;
# spent 35µs making 2 calls to DBI::st::fetchrow_array, avg 18µs/call
27255µs224µs $sth->finish;
# spent 24µs making 2 calls to DBI::st::finish, avg 12µs/call
28
29 # find all columns
302494µ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
37247µs244.1ms $sth->execute($table);
# spent 44.1ms making 2 calls to DBIx::ContextualFetch::st::execute, avg 22.1ms/call
382134µs270µs my $columns = $sth->fetchall_arrayref;
# spent 70µs making 2 calls to DBI::st::fetchall_arrayref, avg 35µs/call
39250µs219µs $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)
432507µ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
48248µs23.99ms $sth->execute($table);
# spent 3.99ms making 2 calls to DBIx::ContextualFetch::st::execute, avg 1.99ms/call
49274µs236µs my ($nextval_str) = $sth->fetchrow_array;
# spent 36µs making 2 calls to DBI::st::fetchrow_array, avg 18µs/call
50252µs223µs $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
53210µs my $sequence;
54220µs if ($nextval_str) {
55268µs23.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...
57295µs437µs ($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
68210µs my ( @cols, @primary );
69257µs foreach my $col (@$columns) {
70 # skip dropped column.
718133µs836µs next if $col->[0] =~ /^\.+pg\.dropped\.\d+\.+$/;
# spent 36µs making 8 calls to Class::DBI::Pg::CORE:match, avg 4µs/call
72847µs push @cols, $col->[0];
73848µs next unless $prinum{ $col->[1] };
74222µs push @primary, $col->[0];
75 }
76210µs if (!@primary) {
77 require Carp;
78 Carp::croak("$table has no primary key");
79 }
80283µs2576µs $class->table($table);
# spent 576µs making 2 calls to Class::DBI::table, avg 288µs/call
81264µs24.99ms $class->columns( Primary => @primary );
# spent 4.99ms making 2 calls to Class::DBI::columns, avg 2.49ms/call
82254µs211.0ms $class->columns( All => @cols );
# spent 11.0ms making 2 calls to Class::DBI::columns, avg 5.51ms/call
832637µs $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 {
87428µs my $class = shift;
88425µs my %args = @_;
89
90473µs430.6ms my $dbh = $class->db_Main;
# spent 30.6ms making 4 calls to Ima::DBI::__ANON__[Ima/DBI.pm:316], avg 7.64ms/call
914223µs41.29ms my $sth = $dbh->prepare("SELECT version()");
# spent 1.29ms making 4 calls to DBI::db::prepare, avg 323µs/call
92472µs420.1ms $sth->execute;
# spent 20.1ms making 4 calls to DBIx::ContextualFetch::st::execute, avg 5.02ms/call
934213µs4116µs my ($ver_str) = $sth->fetchrow_array;
# spent 116µs making 4 calls to DBI::st::fetchrow_array, avg 29µs/call
944125µs455µs $sth->finish;
# spent 55µs making 4 calls to DBI::st::finish, avg 14µs/call
954141µs470µs 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})/;
994925µs 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
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.