6 use warnings FATAL => 'all';
10 use lib File::Spec->catdir( $FindBin::Bin, 'lib' );
12 # This is for the latest version.
13 use lib File::Spec->catdir( $FindBin::Bin, '..', 'lib' );
15 use Getopt::Long qw( GetOptions );
18 my %headerver_to_module = (
19 '0' => 'DBM::Deep::09830',
20 '2' => 'DBM::Deep::10002',
35 'input=s', 'output=s', 'version:s', 'autobless:i',
38 pod2usage(1) if $opts{help};
39 pod2usage(-exitstatus => 0, -verbose => 2) if $opts{man};
41 pod2usage(-msg => "Missing required parameters.", verbose => 1)
42 unless $opts{input} && $opts{output};
44 if ( $opts{input} eq $opts{output} ) {
45 _exit( "Cannot use the same filename for both input and output." );
48 unless ( -f $opts{input} ) {
49 _exit( "'$opts{input}' is not a file." );
54 my $ver = _read_file_header( $opts{input} );
55 if ( $is_dev{ $ver } ) {
56 _exit( "'$opts{input}' is a dev release and not supported." );
59 my $mod = $headerver_to_module{ $ver };
61 $db{input} = $mod->new({
64 autobless => $opts{autobless},
70 my $ver = $opts{version};
71 if ( $ver =~ /^0\.9[1-8]/ ) {
74 elsif ( $ver =~ /^0\.99/) {
77 elsif ( $ver =~ /^1\.000?[0-2]?/) {
80 elsif ( $ver =~ /^1\.000[3]/) {
84 _exit( "'$ver' is an unrecognized version." );
87 if ( $is_dev{ $ver } ) {
88 _exit( "-version '$opts{version}' is a dev release and not supported." );
91 # First thing is to destroy the file, in case it's an incompatible version.
94 my $mod = $headerver_to_module{ $ver };
96 $db{output} = $mod->new({
97 file => $opts{output},
99 autobless => $opts{autobless},
104 # Do the actual conversion. This is the code that compress uses.
105 $db{input}->_copy_node( $db{output} );
108 ################################################################################
110 sub _read_file_header {
113 open my $fh, '<', $file
114 or _exit( "Cannot open '$file' for reading: $!" );
116 my $buffer = _read_buffer( $fh, 9 );
117 _exit( "'$file' is not a DBM::Deep file." )
118 unless length $buffer == 9;
120 my ($file_sig, $header_sig, $header_ver) = unpack( 'A4 A N', $buffer );
123 _exit( "'$file' is not a DBM::Deep file." )
124 unless $file_sig eq 'DPDB';
126 # SIG_HEADER == 'h' - this means that this is a pre-1.0 file
127 return 0 unless ($header_sig eq 'h');
135 read( $fh, $buffer, $len );
141 pod2usage( -verbose => 0, -msg => $msg );
152 upgrade_db.pl -input <oldfile> -output <newfile>
156 This will attempt to upgrade DB files from one version of DBM::Deep to
157 another. The version of the input file is detected from the file header. The
158 version of the output file defaults to the version of the distro in this file,
159 but can be set, if desired.
165 =item B<-input> (required)
167 This is the name of original DB file.
169 =item B<-output> (required)
171 This is the name of target output DB file.
175 Optionally, you can specify the version of L<DBM::Deep> for the output file.
176 This can either be an upgrade or a downgrade. The minimum version supported is
179 If the version is the same as the input file, this acts like a compressed copy
184 In pre-1.0000 versions, autoblessing was an optional setting defaulting to
185 false. Autobless in upgrade_db.pl defaults to true.
189 Prints a brief help message, then exits.
193 Prints a much longer message, then exits;
199 The following are known issues with this converter.
203 =item * Diskspace requirements
205 This will require about twice the diskspace of the input file.
207 =item * Feature support
209 Not all versions support the same features. In particular, internal references
210 were supported in 0.983, removed in 1.000, and re-added in 1.0003. There is no
211 detection of this by upgrade_db.pl.
217 Rob Kinyon, L<rkinyon@cpan.org>
219 Originally written by Rob Kinyon, L<rkinyon@cpan.org>
223 Copyright (c) 2007 Rob Kinyon. All Rights Reserved.
224 This is free software, you may use it and distribute it under the
225 same terms as Perl itself.