This file is indexed.

/usr/share/perl5/DBIx/DBSchema/Column.pm is in libdbix-dbschema-perl 0.45-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
package DBIx::DBSchema::Column;

use strict;
use vars qw($VERSION);
use Carp;
use DBIx::DBSchema::_util qw(_load_driver _dbh _parse_opt);

$VERSION = '0.14';

=head1 NAME

DBIx::DBSchema::Column - Column objects

=head1 SYNOPSIS

  use DBIx::DBSchema::Column;

  #named params with a hashref (preferred)
  $column = new DBIx::DBSchema::Column ( {
    'name'    => 'column_name',
    'type'    => 'varchar'
    'null'    => 'NOT NULL',
    'length'  => 64,
    'default' => '',
    'local'   => '',
  } );

  #list
  $column = new DBIx::DBSchema::Column ( $name, $sql_type, $nullability, $length, $default, $local );

  $name = $column->name;
  $column->name( 'name' );

  $sql_type = $column->type;
  $column->type( 'sql_type' );

  $null = $column->null;
  $column->null( 'NULL' );
  $column->null( 'NOT NULL' );
  $column->null( '' );

  $length = $column->length;
  $column->length( '10' );
  $column->length( '8,2' );

  $default = $column->default;
  $column->default( 'Roo' );

  $sql_line = $column->line;
  $sql_line = $column->line($datasrc);

  $sql_add_column = $column->sql_add_column;
  $sql_add_column = $column->sql_add_column($datasrc);

=head1 DESCRIPTION

DBIx::DBSchema::Column objects represent columns in tables (see
L<DBIx::DBSchema::Table>).

=head1 METHODS

=over 4

=item new HASHREF

=item new [ name [ , type [ , null [ , length  [ , default [ , local ] ] ] ] ] ]

Creates a new DBIx::DBSchema::Column object.  Takes a hashref of named
parameters, or a list.  B<name> is the name of the column.  B<type> is the SQL
data type.  B<null> is the nullability of the column (intrepreted using Perl's
rules for truth, with one exception: `NOT NULL' is false).  B<length> is the
SQL length of the column.  B<default> is the default value of the column.
B<local> is reserved for database-specific information.

Note: If you pass a scalar reference as the B<default> rather than a scalar value, it will be dereferenced and quoting will be forced off.  This can be used to pass SQL functions such as C<now()> or explicit empty strings as C<''> as
defaults.

=cut

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;

  my $self;
  if ( ref($_[0]) ) {
    $self = shift;
  } else {
    #carp "Old-style $class creation without named parameters is deprecated!";
    #croak "FATAL: old-style $class creation no longer supported;".
    #      " use named parameters";

    $self = { map { $_ => shift } qw(name type null length default local) };
  }

  #croak "Illegal name: ". $self->{'name'}
  #  if grep $self->{'name'} eq $_, @reserved_words;

  $self->{'null'} =~ s/^NOT NULL$//i;
  $self->{'null'} = 'NULL' if $self->{'null'};

  bless ($self, $class);

}

=item name [ NAME ]

Returns or sets the column name.

=cut

sub name {
  my($self,$value)=@_;
  if ( defined($value) ) {
  #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
    $self->{'name'} = $value;
  } else {
    $self->{'name'};
  }
}

=item type [ TYPE ]

Returns or sets the column type.

=cut

sub type {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{'type'} = $value;
  } else {
    $self->{'type'};
  }
}

=item null [ NULL ]

Returns or sets the column null flag (the empty string is equivalent to
`NOT NULL')

=cut

sub null {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $value =~ s/^NOT NULL$//i;
    $value = 'NULL' if $value;
    $self->{'null'} = $value;
  } else {
    $self->{'null'};
  }
}

=item length [ LENGTH ]

Returns or sets the column length.

=cut

sub length {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{'length'} = $value;
  } else {
    $self->{'length'};
  }
}

=item default [ LOCAL ]

Returns or sets the default value.

=cut

sub default {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{'default'} = $value;
  } else {
    $self->{'default'};
  }
}


=item local [ LOCAL ]

Returns or sets the database-specific field.

=cut

sub local {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{'local'} = $value;
  } else {
    $self->{'local'};
  }
}

=item table_obj [ TABLE_OBJ ]

Returns or sets the table object (see L<DBIx::DBSchema::Table>).  Typically
set internally when a column object is added to a table object.

=cut

sub table_obj {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{'table_obj'} = $value;
  } else {
    $self->{'table_obj'};
  }
}

=item table_name

Returns the table name, or the empty string if this column has not yet been
assigned to a table.

=cut

sub table_name {
  my $self = shift;
  $self->{'table_obj'} ? $self->{'table_obj'}->name : '';
}

=item line [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]

Returns an SQL column definition.

The data source can be specified by passing an open DBI database handle, or by
passing the DBI data source name, username and password.  

Although the username and password are optional, it is best to call this method
with a database handle or data source including a valid username and password -
a DBI connection will be opened and the quoting and type mapping will be more
reliable.

If passed a DBI data source (or handle) such as `DBI:mysql:database' or
`DBI:Pg:dbname=database', will use syntax specific to that database engine.
Currently supported databases are MySQL and PostgreSQL.  Non-standard syntax
for other engines (if applicable) may also be supported in the future.

=cut

sub line {
  my($self, $dbh) = ( shift, _dbh(@_) );

  my $driver = $dbh ? _load_driver($dbh) : '';
  my $dbd = "DBIx::DBSchema::DBD::$driver";

  ##
  # type mapping
  ## 

  my %typemap;
  %typemap = eval "\%${dbd}::typemap" if $driver;
  my $type = defined( $typemap{uc($self->type)} )
    ? $typemap{uc($self->type)}
    : $self->type;

  ##
  # callback into the database-specific driver
  ##

  my $hashref = $dbd->column_callback( $dbh, $self->table_name, $self );

  $type = $hashref->{'effective_type'}
    if $hashref->{'effective_type'};

  my $null = $self->null;

  #we seem to do this for mysql/Pg/SQLite, i think this should be the default
  #add something to $hashref if drivers need to overrdide?
  $null ||= "NOT NULL";

  $null =~ s/^NULL$// unless $hashref->{'explicit_null'};

  my $default = $hashref->{'effective_default'} || $self->quoted_default($dbh);
  $default = "DEFAULT $default" if $default ne '';

  my $local = $self->local;
  $local = $hashref->{'effective_local'}
    if $hashref->{'effective_local'};

  ##
  # return column line
  ## 

  join(' ',
    $self->name,
    $type. ( ( defined($self->length) && $self->length )
             ? '('.$self->length.')'
             : ''
           ),
    $null,
    $default,
    ( defined($local) ? $local : ''),
  );

}

=item quoted_default DATABASE_HANDLE

Returns this column's default value quoted for the database.

=cut

sub quoted_default {
  my($self, $dbh) = @_;
  my $driver = $dbh ? _load_driver($dbh) : '';

  return ${$self->default} if ref($self->default);

  my $dbd = "DBIx::DBSchema::DBD::$driver";

  return $dbh->quote($self->default)
    if defined($self->default)
    && $self->default ne ''
    && ref($dbh)
    && $dbd->column_value_needs_quoting($self);
  
  return $self->default;

}

=item sql_add_column [ DBH ]

Returns SQL to add this column to an existing table.  (To create a new table,
see L<DBIx::DBSchema::Table/sql_create_table> instead.)

NOTE: This interface has changed in 0.41

Returns two listrefs.  The first is a list of column alteration SQL fragments
for an ALTER TABLE statement.  The second is a list of full SQL statements that
should be run after the ALTER TABLE statement.

The data source can be specified by passing an open DBI database handle, or by
passing the DBI data source name, username and password.  

Although the username and password are optional, it is best to call this method
with a database handle or data source including a valid username and password -
a DBI connection will be opened and the quoting and type mapping will be more
reliable.

If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
use PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
applicable) may also be supported in the future.

=cut

sub sql_add_column {
  my($self, $dbh) = ( shift, _dbh(@_) );

  die "$self: this column is not assigned to a table"
    unless $self->table_name;

  my $driver = $dbh ? _load_driver($dbh) : '';

  my @alter_table = ();
  my @sql = ();
  my $table = $self->table_name;

  my $dbd = "DBIx::DBSchema::DBD::$driver";
  my $hashref = $dbd->add_column_callback( $dbh, $table, $self );

  my $real_type = '';
  if ( $hashref->{'effective_type'} ) {
    $real_type = $self->type;
    $self->type($hashref->{'effective_type'});
  }

  my $real_null = undef;
  if ( exists($hashref->{'effective_null'}) ) {
    $real_null = $self->null;
    $self->null($hashref->{'effective_null'});
  }

  push @alter_table, "ADD COLUMN ". $self->line($dbh);

  push @sql, @{ $hashref->{'sql_after'} } if $hashref->{'sql_after'};

  push @sql, "ALTER TABLE $table ADD PRIMARY KEY ( ".
             $self->table_obj->primary_key. " )"
    if $self->name eq $self->table_obj->primary_key;

  $self->type($real_type) if $real_type;
  $self->null($real_null) if defined $real_null;

  (\@alter_table, \@sql);

}

=item sql_alter_column PROTOTYPE_COLUMN  [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]

Returns SQL to alter this column so that it is identical to the provided
prototype column, also a DBIx::DBSchema::Column object.

NOTE: This interface has changed in 0.41

Returns two listrefs.  The first is a list of column alteration SQL fragments
for an ALTER TABLE statement.  The second is a list of full SQL statements that
should be run after the ALTER TABLE statement.

Optionally, the data source can be specified by passing an open DBI database
handle, or by passing the DBI data source name, username and password.  

If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
use PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
applicable) may also be supported in the future.

If not passed a data source (or handle), or if there is no driver for the
specified database, will attempt to use generic SQL syntax.

=cut

sub sql_alter_column {
  my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );

  my $table = $self->table_name;
  die "$self: this column is not assigned to a table"
    unless $table;

  my $name = $self->name;

  my $driver = $dbh ? _load_driver($dbh) : '';

  my @alter_table = ();
  my @sql = ();

  my $dbd = "DBIx::DBSchema::DBD::$driver";
  my $hashref = $dbd->alter_column_callback( $dbh, $table, $self, $new );

  if ( $hashref->{'sql_alter'} ) {

    push @sql, $hashref->{'sql_alter'};

  } else {

    # change the name...
    # not yet implemented.  how do we tell which old column it was?

    # change the type...
    if ( $hashref->{'sql_alter_type'} ) {
      push @alter_table, $hashref->{'sql_alter_type'};
    }

    # change nullability...

    if ( $hashref->{'sql_alter_null'} ) {

      push @sql, $hashref->{'sql_alter_null'};

    } else {

      # change nullability from NOT NULL to NULL
      if ( ! $self->null && $new->null ) {
    
        push @alter_table, "ALTER COLUMN $name DROP NOT NULL";
    
      }
    
      # change nullability from NULL to NOT NULL...
      # this one could be more complicated, need to set a DEFAULT value and update
      # the table first...
      if ( $self->null && ! $new->null ) {
    
        push @alter_table, "ALTER COLUMN $name SET NOT NULL";
    
      }

    }

    # change default
    my $old_default = $self->quoted_default($dbh);
    my $new_default = $new->quoted_default($dbh);
    if ( $old_default ne $new_default
         && ( uc($old_default) ne 'NOW()' || uc($new_default) ne 'NOW()' )
       )
    {

      #warn "old default: $old_default / new default: $new_default\n";

      my $alter = "ALTER COLUMN $name";

      if ( $new_default ne '' ) {
        #warn "changing from $old_default to $new_default\n";
        push @alter_table, "$alter SET DEFAULT $new_default";
      } elsif ( $old_default !~ /^nextval/i ) { #Pg-specific :(
        push @alter_table, "$alter DROP DEFAULT";

        push @sql, "UPDATE TABLE $table SET $name = NULL WHERE $name = ''"
          if $opt->{'nullify_default'} && $old_default eq "''" && $new->null;
      }

    }

    # change other stuff... (what next?)

  }

  (\@alter_table, \@sql);

}

=item sql_drop_column [ DBH ] 

Returns SQL to drop this column from an existing table.

NOTE: This interface has changed in 0.41

Returns a list of column alteration SQL fragments for an ALTER TABLE statement. 

The optional database handle or DBI data source/username/password is not yet
used.

=cut

sub sql_drop_column {
 my( $self, $dbh ) = ( shift, _dbh(@_) );
 
 my $table = $self->table_name;
 my $name = $self->name;
 
 ("DROP COLUMN $name"); # XXX what about indexes???
}

=back

=head1 AUTHOR

Ivan Kohler <ivan-dbix-dbschema@420.am>

=head1 COPYRIGHT

Copyright (c) 2000-2006 Ivan Kohler
Copyright (c) 2007-2013 Freeside Internet Services, Inc.
All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 BUGS

The new() method should warn that 
"Old-style $class creation without named parameters is deprecated!"

Better documentation is needed for sql_add_column

sql_alter_column() has database-specific foo that should be abstracted info
DBIx::DBSchema::DBD::Pg

nullify_default option should be documented

=head1 SEE ALSO

L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>

=cut

1;