← Back to branch summary

~ubuntu-branches/ubuntu/saucy/padre/saucy-proposed

« back to all changes in this revision

Viewing changes to lib/Padre/DB/Migrate.pm

  • Committer: Package Import Robot
  • Author(s): Dominique Dumont, gregor herrmann, Dominique Dumont
  • Date: 2012-01-04 12:04:20 UTC
  • mfrom: (1.3.3)
  • Revision ID: package-import@ubuntu.com-20120104120420-i5oybqwf91m1d3il
Tags: 0.92.ds1-1
[ gregor herrmann ]
* Remove debian/source/local-options; abort-on-upstream-changes
  and unapply-patches are default in dpkg-source since 1.16.1.
* Swap order of alternative (build) dependencies after the perl
  5.14 transition.

[ Dominique Dumont ]
* Imported Upstream version 0.92.ds1
* removed fix-spelling patch (applied upstream)
* lintian-override: use wildcard to avoid listing a gazillion files
* updated size of some 'not-real-man-page' entries
* rules: remove dekstop cruft (replaced by a file provided in debian
  directory)
* control: removed Breaks statement. Add /me to uploaders. Updated
  dependencies
* rules: make sure that non-DFSG file (i.e. the cute butterfly, sigh)
  is not distributed

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Padre/DB/Migrate.pm
1
 
package Padre::DB::Migrate;
2
 
 
3
 
# This is a highly modified variant of ORLite::Migrate
4
 
 
5
 
use 5.008005;
6
 
use strict;
7
 
use warnings;
8
 
use Carp          ();
9
 
use Class::Unload ();
10
 
use File::Spec 3.2701 ();
11
 
use File::Path 2.04   ();
12
 
use File::Basename ();
13
 
use Params::Util 0.37 ();
14
 
use DBI 1.58          ();
15
 
use DBD::SQLite 1.21  ();
16
 
use ORLite 1.28       ();
17
 
 
18
 
our $VERSION = '0.90';
19
 
our @ISA     = 'ORLite';
20
 
 
21
 
sub import {
22
 
        my $class = ref $_[0] || $_[0];
23
 
 
24
 
        # Check for debug mode
25
 
        my $DEBUG = 0;
26
 
        if ( defined Params::Util::_STRING( $_[-1] ) and $_[-1] eq '-DEBUG' ) {
27
 
                $DEBUG = 1;
28
 
                pop @_;
29
 
        }
30
 
 
31
 
        # Check params and apply defaults
32
 
        my %params;
33
 
        if ( defined Params::Util::_STRING( $_[1] ) ) {
34
 
 
35
 
                # Migrate needs at least two params
36
 
                Carp::croak("Padre::DB::Migrate must be invoked in HASH form");
37
 
        } elsif ( Params::Util::_HASH( $_[1] ) ) {
38
 
                %params = %{ $_[1] };
39
 
        } else {
40
 
                Carp::croak("Missing, empty or invalid params HASH");
41
 
        }
42
 
        $params{create} = $params{create} ? 1 : 0;
43
 
        unless (
44
 
                defined Params::Util::_STRING( $params{file} )
45
 
                and ( $params{create}
46
 
                        or -f $params{file} )
47
 
                )
48
 
        {
49
 
                Carp::croak("Missing or invalid file param");
50
 
        }
51
 
        unless ( defined $params{readonly} ) {
52
 
                $params{readonly} = $params{create} ? 0 : !-w $params{file};
53
 
        }
54
 
        unless ( defined $params{tables} ) {
55
 
                $params{tables} = 1;
56
 
        }
57
 
        unless ( defined $params{package} ) {
58
 
                $params{package} = scalar caller;
59
 
        }
60
 
        unless ( Params::Util::_CLASS( $params{package} ) ) {
61
 
                Carp::croak("Missing or invalid package class");
62
 
        }
63
 
 
64
 
        # We don't support readonly databases
65
 
        if ( $params{readonly} ) {
66
 
                Carp::croak("Padre::DB::Migrate does not support readonly databases");
67
 
        }
68
 
 
69
 
        # Get the schema version
70
 
        my $file    = File::Spec->rel2abs( $params{file} );
71
 
        my $created = !-f $params{file};
72
 
        if ($created) {
73
 
 
74
 
                # Create the parent directory
75
 
                my $dir = File::Basename::dirname($file);
76
 
                unless ( -d $dir ) {
77
 
                        my @dirs = File::Path::mkpath( $dir, { verbose => 0 } );
78
 
                        $class->prune(@dirs) if $params{prune};
79
 
                }
80
 
                $class->prune($file) if $params{prune};
81
 
        }
82
 
 
83
 
        # We're done with the prune setting now
84
 
        $params{prune} = 0;
85
 
 
86
 
        # Get the current schema version
87
 
        my $dsn     = "dbi:SQLite(AutoCommit=>1,RaiseError=>1,PrintError=>0):$file";
88
 
        my $dbh     = DBI->connect($dsn);
89
 
        my $version = $dbh->selectrow_arrayref('pragma user_version')->[0];
90
 
        my $want    = $params{user_version};
91
 
 
92
 
        # Attempt to roll the schema version forwards
93
 
        if ( $want and $want > $version ) {
94
 
                require Padre::DB::Timeline;
95
 
                Padre::DB::Timeline->new( dbh => $dbh )->upgrade($want);
96
 
                Class::Unload->unload('Padre::DB::Timeline');
97
 
        }
98
 
 
99
 
        # We are finished with the database
100
 
        $dbh->disconnect;
101
 
 
102
 
        local $SIG{__WARN__} = sub {
103
 
                return if $_[0] =~ /Subroutine \w+ redefined at/;
104
 
                warn $_[0];
105
 
        };
106
 
 
107
 
        # Hand off to the regular constructor
108
 
        $class->SUPER::import(
109
 
                \%params,
110
 
                $DEBUG ? '-DEBUG' : ()
111
 
        );
112
 
}
113
 
 
114
 
1;
115
 
 
116
 
# Copyright 2008-2011 The Padre development team as listed in Padre.pm.
117
 
# LICENSE
118
 
# This program is free software; you can redistribute it and/or
119
 
# modify it under the same terms as Perl 5 itself.