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',
34 'input=s', 'output=s', 'version:s', 'autobless:i',
37 pod2usage(1) if $opts{help};
38 pod2usage(-exitstatus => 0, -verbose => 2) if $opts{man};
40 pod2usage(-msg => "Missing required parameters.", verbose => 1)
41 unless $opts{input} && $opts{output};
43 if ( $opts{input} eq $opts{output} ) {
44 _exit( "Cannot use the same filename for both input and output." );
47 unless ( -f $opts{input} ) {
48 _exit( "'$opts{input}' is not a file." );
53 my $ver = _read_file_header( $opts{input} );
54 if ( $is_dev{ $ver } ) {
55 _exit( "'$opts{input}' is a dev release and not supported." );
58 my $mod = $headerver_to_module{ $ver };
60 $db{input} = $mod->new({
63 autobless => $opts{autobless},
69 my $ver = $opts{version};
70 if ( $ver =~ /^0\.9[1-8]/ ) {
73 elsif ( $ver =~ /^0\.99/) {
76 elsif ( $ver =~ /^1\.000?0?/) {
80 _exit( "'$ver' is an unrecognized version." );
83 if ( $is_dev{ $ver } ) {
84 _exit( "-version '$opts{version}' is a dev release and not supported." );
87 # First thing is to destroy the file, in case it's an incompatible version.
90 my $mod = $headerver_to_module{ $ver };
92 $db{output} = $mod->new({
93 file => $opts{output},
95 autobless => $opts{autobless},
100 # Do the actual conversion. This is the code that compress uses.
101 $db{input}->_copy_node( $db{output} );
104 ################################################################################
106 sub _read_file_header {
109 open my $fh, '<', $file
110 or _exit( "Cannot open '$file' for reading: $!" );
112 my $buffer = _read_buffer( $fh, 9 );
113 _exit( "'$file' is not a DBM::Deep file." )
114 unless length $buffer == 9;
116 my ($file_sig, $header_sig, $header_ver) = unpack( 'A4 A N', $buffer );
119 _exit( "'$file' is not a DBM::Deep file." )
120 unless $file_sig eq 'DPDB';
122 # SIG_HEADER == 'h' - this means that this is a pre-1.0 file
123 return 0 unless ($header_sig eq 'h');
131 read( $fh, $buffer, $len );
137 pod2usage( -verbose => 0, -msg => $msg );
148 upgrade_db.pl -input <oldfile> -output <newfile>
152 This will attempt to upgrade DB files from one version of DBM::Deep to
153 another. The version of the input file is detected from the file header. The
154 version of the output file defaults to the version of the distro in this file,
155 but can be set, if desired.
161 =item B<-input> (required)
163 This is the name of original DB file.
165 =item B<-output> (required)
167 This is the name of target output DB file.
171 Optionally, you can specify the version of L<DBM::Deep> for the output file.
172 This can either be an upgrade or a downgrade. The minimum version supported is
175 If the version is the same as the input file, this acts like a compressed copy
180 In pre-1.0000 versions, autoblessing was an optional setting. This defaults to
185 Prints a brief help message, then exits.
189 Prints a much longer message, then exits;
195 The following are known issues with this converter.
199 =item * Diskspace requirements
201 This will require about twice the diskspace of the input file.
203 =item * Feature support
205 Not all versions support the same features. In particular, internal references
206 were supported in 0.983 and support was removed in 1.000. There is no
207 detection of this by upgrade_db.pl.
213 Rob Kinyon, L<rkinyon@cpan.org>
215 Originally written by Rob Kinyon, L<rkinyon@cpan.org>
219 Copyright (c) 2007 Rob Kinyon. All Rights Reserved.
220 This is free software, you may use it and distribute it under the
221 same terms as Perl itself.