lib/SQL/Translator.pm

   1 package SQL::Translator;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Translator.pm,v 1.8 2002-07-08 14:42:56 dlc Exp $
   5 # ----------------------------------------------------------------------
   6 # Copyright (C) 2002 Ken Y. Clark <kycl4rk@users.sourceforge.net>,
   7 #                    darren chamberlain <darren@cpan.org>
   8 #
   9 # This program is free software; you can redistribute it and/or
  10 # modify it under the terms of the GNU General Public License as
  11 # published by the Free Software Foundation; version 2.
  12 #
  13 # This program is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 # General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, write to the Free Software
  20 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  21 # 02111-1307  USA
  22 # -------------------------------------------------------------------
  23
  24 =head1 NAME
  25
  26 SQL::Translator - convert schema from one database to another
  27
  28 =head1 SYNOPSIS
  29
  30   use SQL::Translator;
  31   my $translator = SQL::Translator->new;
  32
  33   my $output = $translator->translate(
  34                       from     => "MySQL",
  35                       to       => "Oracle",
  36                       filename => $file,
  37                ) or die $translator->error;
  38   print $output;
  39
  40 =head1 DESCRIPTION
  41
  42 This module attempts to simplify the task of converting one database
  43 create syntax to another through the use of Parsers (which understand
  44 the sourced format) and Producers (which understand the destination
  45 format).  The idea is that any Parser can be used with any Producer in
  46 the conversion process.  So, if you wanted PostgreSQL-to-Oracle, you
  47 would use the PostgreSQL parser and the Oracle producer.
  48
  49 =cut
  50
  51 use strict;
  52 use vars qw($VERSION $DEFAULT_SUB $DEBUG);
  53 $VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/;
  54 $DEBUG = 1 unless defined $DEBUG;
  55
  56 # ----------------------------------------------------------------------
  57 # The default behavior is to "pass through" values (note that the
  58 # SQL::Translator instance is the first value ($_[0]), and the stuff
  59 # to be parsed is the second value ($_[1])
  60 # ----------------------------------------------------------------------
  61 $DEFAULT_SUB = sub { $_[1] } unless defined $DEFAULT_SUB;
  62
  63 *isa = \&UNIVERSAL::isa;
  64
  65 use Carp qw(carp);
  66
  67 =head1 CONSTRUCTOR
  68
  69 The constructor is called B<new>, and accepts a optional hash of options.
  70 Valid options are:
  71
  72 =over 4
  73
  74 =item parser (aka from)
  75
  76 =item parser_args
  77
  78 =item producer (aka to)
  79
  80 =item producer_args
  81
  82 =item filename (aka file)
  83
  84 =item data
  85
  86 =item debug
  87
  88 =back
  89
  90 All options are, well, optional; these attributes can be set via
  91 instance methods.  Internally, they are; no (non-syntactical)
  92 advantage is gained by passing options to the constructor.
  93
  94 =cut
  95
  96 # ----------------------------------------------------------------------
  97 # new([ARGS])
  98 #   The constructor.
  99 #
 100 #   new takes an optional hash of arguments.  These arguments may
 101 #   include a parser, specified with the keys "parser" or "from",
 102 #   and a producer, specified with the keys "producer" or "to".
 103 #
 104 #   The values that can be passed as the parser or producer are
 105 #   given directly to the parser or producer methods, respectively.
 106 #   See the appropriate method description below for details about
 107 #   what each expects/accepts.
 108 # ----------------------------------------------------------------------
 109 sub new {
 110     my $class = shift;
 111     my $args  = $_[0] && isa($_[0], 'HASH') ? shift : { @_ };
 112     my $self  = bless { } => $class;
 113
 114     # ------------------------------------------------------------------
 115     # Set the parser and producer.
 116     #
 117     # If a 'parser' or 'from' parameter is passed in, use that as the
 118     # parser; if a 'producer' or 'to' parameter is passed in, use that
 119     # as the producer; both default to $DEFAULT_SUB.
 120     # ------------------------------------------------------------------
 121     $self->parser(  $args->{'parser'}   || $args->{'from'} || $DEFAULT_SUB);
 122     $self->producer($args->{'producer'} || $args->{'to'}   || $DEFAULT_SUB);
 123
 124     # ------------------------------------------------------------------
 125     # Set the parser_args and producer_args
 126     # ------------------------------------------------------------------
 127     for my $pargs (qw(parser_args producer_args)) {
 128         $self->$pargs($args->{$pargs}) if defined $args->{$pargs};
 129     }
 130
 131     # ------------------------------------------------------------------
 132     # Set the data source, if 'filename' or 'file' is provided.
 133     # ------------------------------------------------------------------
 134     $args->{'filename'} ||= $args->{'file'} || "";
 135     $self->filename($args->{'filename'}) if $args->{'filename'};
 136
 137     # ------------------------------------------------------------------
 138     # Finally, if there is a 'data' parameter, use that in preference
 139     # to filename and file
 140     # ------------------------------------------------------------------
 141     if (my $data = $args->{'data'}) {
 142         $self->data($data);
 143     }
 144
 145     $self->{'debug'} = $DEBUG;
 146     $self->{'debug'} = $args->{'debug'} if (defined $args->{'debug'});
 147
 148     # ------------------------------------------------------------------
 149     # Clear the error
 150     # ------------------------------------------------------------------
 151     $self->error_out("");
 152
 153     return $self;
 154 }
 155
 156 =head1 METHODS
 157
 158 =head2 B<producer>
 159
 160 The B<producer> method is an accessor/mutator, used to retrieve or
 161 define what subroutine is called to produce the output.  A subroutine
 162 defined as a producer will be invoked as a function (not a method) and
 163 passed 2 parameters: its container SQL::Translator instance and a
 164 data structure.  It is expected that the function transform the data
 165 structure to a string.  The SQL::Transformer instance is provided for
 166 informational purposes; for example, the type of the parser can be
 167 retrieved using the B<parser_type> method, and the B<error> and
 168 B<debug> methods can be called when needed.
 169
 170 When defining a producer, one of several things can be passed
 171 in:  A module name (e.g., My::Groovy::Producer), a module name
 172 relative to the SQL::Translator::Producer namespace (e.g., MySQL), a
 173 module name and function combination (My::Groovy::Producer::transmogrify),
 174 or a reference to an anonymous subroutine.  If a full module name is
 175 passed in (for the purposes of this method, a string containing "::"
 176 is considered to be a module name), it is treated as a package, and a
 177 function called "produce" will be invoked: $modulename::produce.  If
 178 $modulename cannot be loaded, the final portion is stripped off and
 179 treated as a function.  In other words, if there is no file named
 180 My/Groovy/Producer/transmogrify.pm, SQL::Translator will attempt to load
 181 My/Groovy/Producer.pm and use transmogrify as the name of the function,
 182 instead of the default "produce".
 183
 184   my $tr = SQL::Translator->new;
 185
 186   # This will invoke My::Groovy::Producer::produce($tr, $data)
 187   $tr->producer("My::Groovy::Producer");
 188
 189   # This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
 190   $tr->producer("Sybase");
 191
 192   # This will invoke My::Groovy::Producer::transmogrify($tr, $data),
 193   # assuming that My::Groovy::Producer::transmogrify is not a module
 194   # on disk.
 195   $tr->producer("My::Groovy::Producer::transmogrify");
 196
 197   # This will invoke the referenced subroutine directly, as
 198   # $subref->($tr, $data);
 199   $tr->producer(\&my_producer);
 200
 201 There is also a method named B<producer_type>, which is a string
 202 containing the classname to which the above B<produce> function
 203 belongs.  In the case of anonymous subroutines, this method returns
 204 the string "CODE".
 205
 206 Finally, there is a method named B<producer_args>, which is both an
 207 accessor and a mutator.  Arbitrary data may be stored in name => value
 208 pairs for the producer subroutine to access:
 209
 210   sub My::Random::producer {
 211       my ($tr, $data) = @_;
 212       my $pr_args = $tr->producer_args();
 213
 214       # $pr_args is a hashref.
 215
 216 Extra data passed to the B<producer> method is passed to
 217 B<producer_args>:
 218
 219   $tr->producer("xSV", delimiter => ',\s*');
 220
 221   # In SQL::Translator::Producer::xSV:
 222   my $args = $tr->producer_args;
 223   my $delimiter = $args->{'delimiter'}; # value is ,\s*
 224
 225 =cut
 226
 227 # producer and producer_type
 228 sub producer {
 229     my $self = shift;
 230
 231     # producer as a mutator
 232     if (@_) {
 233         my $producer = shift;
 234
 235         # Passed a module name (string containing "::")
 236         if ($producer =~ /::/) {
 237             my $func_name;
 238
 239             # Module name was passed directly
 240             # We try to load the name; if it doesn't load, there's
 241             # a possibility that it has a function name attached to
 242             # it.
 243             if (load($producer)) {
 244                 $func_name = "produce";
 245             }
 246
 247             # Module::function was passed
 248             else {
 249                 # Passed Module::Name::function; try to recover
 250                 my @func_parts = split /::/, $producer;
 251                 $func_name = pop @func_parts;
 252                 $producer = join "::", @func_parts;
 253
 254                 # If this doesn't work, then we have a legitimate
 255                 # problem.
 256                 load($producer) or die "Can't load $producer: $@";
 257             }
 258
 259             # get code reference and assign
 260             $self->{'producer'} = \&{ "$producer\::$func_name" };
 261             $self->{'producer_type'} = $producer;
 262             $self->debug("Got producer: $producer\::$func_name");
 263         }
 264
 265         # passed an anonymous subroutine reference
 266         elsif (isa($producer, 'CODE')) {
 267             $self->{'producer'} = $producer;
 268             $self->{'producer_type'} = "CODE";
 269             $self->debug("Got producer: code ref");
 270         }
 271
 272         # passed a string containing no "::"; relative package name
 273         else {
 274             my $Pp = sprintf "SQL::Translator::Producer::$producer";
 275             load($Pp) or die "Can't load $Pp: $@";
 276             $self->{'producer'} = \&{ "$Pp\::produce" };
 277             $self->{'producer_type'} = $Pp;
 278             $self->debug("Got producer: $Pp");
 279         }
 280
 281         # At this point, $self->{'producer'} contains a subroutine
 282         # reference that is ready to run
 283
 284         # Anything left?  If so, it's producer_args
 285         $self->producer_args(@_) if (@_);
 286     }
 287
 288     return $self->{'producer'};
 289 };
 290
 291 # ----------------------------------------------------------------------
 292 # producer_type
 293 #
 294 # producer_type is an accessor that allows producer subs to get
 295 # information about their origin.  This is poptentially important;
 296 # since all producer subs are called as subroutine refernces, there is
 297 # no way for a producer to find out which package the sub lives in
 298 # originally, for example.
 299 # ----------------------------------------------------------------------
 300 sub producer_type { $_[0]->{'producer_type'} }
 301
 302 # ----------------------------------------------------------------------
 303 # producer_args
 304 #
 305 # Arbitrary name => value pairs of paramters can be passed to a
 306 # producer using this method.
 307 # ----------------------------------------------------------------------
 308 sub producer_args {
 309     my $self = shift;
 310     if (@_) {
 311         my $args = isa($_[0], 'HASH') ? shift : { @_ };
 312         $self->{'producer_args'} = $args;
 313     }
 314     $self->{'producer_args'};
 315 }
 316
 317 =head2 B<parser>
 318
 319 The B<parser> method defines or retrieves a subroutine that will be
 320 called to perform the parsing.  The basic idea is the same as that of
 321 B<producer> (see above), except the default subroutine name is
 322 "parse", and will be invoked as $module_name::parse($tr, $data).
 323 Also, the parser subroutine will be passed a string containing the
 324 entirety of the data to be parsed (or possibly a reference to a string?).
 325
 326   # Invokes SQL::Translator::Parser::MySQL::parse()
 327   $tr->parser("MySQL");
 328
 329   # Invokes My::Groovy::Parser::parse()
 330   $tr->parser("My::Groovy::Parser");
 331
 332   # Invoke an anonymous subroutine directly
 333   $tr->parser(sub {
 334     my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
 335     $dumper->Purity(1)->Terse(1)->Deepcopy(1);
 336     return $dumper->Dump;
 337   });
 338
 339 There is also B<parser_type> and B<parser_args>, which perform
 340 analogously to B<producer_type> and B<producer_args>
 341
 342 =cut
 343
 344 sub parser {
 345     my $self = shift;
 346
 347     # parser as a mutator
 348     if (@_) {
 349         my $parser = shift;
 350
 351         # Passed a module name (string containing "::")
 352         if ($parser =~ /::/) {
 353             my $func_name;
 354
 355             # Module name was passed directly
 356             # We try to load the name; if it doesn't load, there's
 357             # a possibility that it has a function name attached to
 358             # it.
 359             if (load($parser)) {
 360                 $func_name = "parse";
 361             }
 362
 363             # Module::function was passed
 364             else {
 365                 # Passed Module::Name::function; try to recover
 366                 my @func_parts = split /::/, $parser;
 367                 $func_name = pop @func_parts;
 368                 $parser = join "::", @func_parts;
 369
 370                 # If this doesn't work, then we have a legitimate
 371                 # problem.
 372                 load($parser) or die "Can't load $parser: $@";
 373             }
 374
 375             # get code reference and assign
 376             $self->{'parser'} = \&{ "$parser\::$func_name" };
 377             $self->{'parser_type'} = $parser;
 378             $self->debug("Got parser: $parser\::$func_name");
 379         }
 380
 381         # passed an anonymous subroutine reference
 382         elsif (isa($parser, 'CODE')) {
 383             $self->{'parser'} = $parser;
 384             $self->{'parser_type'} = "CODE";
 385             $self->debug("Got parser: code ref");
 386         }
 387
 388         # passed a string containing no "::"; relative package name
 389         else {
 390             my $Pp = sprintf "SQL::Translator::Parser::$parser";
 391             load($Pp) or die "Can't load $Pp: $@";
 392             $self->{'parser'} = \&{ "$Pp\::parse" };
 393             $self->{'parser_type'} = $Pp;
 394             $self->debug("Got parser: $Pp");
 395         }
 396
 397         # At this point, $self->{'parser'} contains a subroutine
 398         # reference that is ready to run
 399
 400         $self->parser_args(@_) if (@_);
 401     }
 402
 403     return $self->{'parser'};
 404 }
 405
 406 sub parser_type { $_[0]->{'parser_type'} }
 407
 408 # parser_args
 409 sub parser_args {
 410     my $self = shift;
 411     if (@_) {
 412         my $args = isa($_[0], 'HASH') ? shift : { @_ };
 413         $self->{'parser_args'} = $args;
 414     }
 415     $self->{'parser_args'};
 416 }
 417
 418 =head2 B<translate>
 419
 420 The B<translate> method calls the subroutines referenced by the
 421 B<parser> and B<producer> data members (described above).  It accepts
 422 as arguments a number of things, in key => value format, including
 423 (potentially) a parser and a producer (they are passed directly to the
 424 B<parser> and B<producer> methods).
 425
 426 Here is how the parameter list to B<translate> is parsed:
 427
 428 =over
 429
 430 =item *
 431
 432 1 argument means it's the data to be parsed; which could be a string
 433 (filename) or a refernce to a scalar (a string stored in memory), or a
 434 reference to a hash, which is parsed as being more than one argument
 435 (see next section).
 436
 437   # Parse the file /path/to/datafile
 438   my $output = $tr->translate("/path/to/datafile");
 439
 440   # Parse the data contained in the string $data
 441   my $output = $tr->translate(\$data);
 442
 443 =item *
 444
 445 More than 1 argument means its a hash of things, and it might be
 446 setting a parser, producer, or datasource (this key is named
 447 "filename" or "file" if it's a file, or "data" for a SCALAR reference.
 448
 449   # As above, parse /path/to/datafile, but with different producers
 450   for my $prod ("MySQL", "XML", "Sybase") {
 451       print $tr->translate(
 452                 producer => $prod,
 453                 filename => "/path/to/datafile",
 454             );
 455   }
 456
 457   # The filename hash key could also be:
 458       datasource => \$data,
 459
 460 You get the idea.
 461
 462 =back
 463
 464 =head2 B<filename>, B<data>
 465
 466 Using the B<filename> method, the filename of the data to be parsed
 467 can be set. This method can be used in conjunction with the B<data>
 468 method, below.  If both the B<filename> and B<data> methods are
 469 invoked as mutators, the data set in the B<data> method is used.
 470
 471     $tr->filename("/my/data/files/create.sql");
 472
 473 or:
 474
 475     my $create_script = do {
 476         local $/;
 477         open CREATE, "/my/data/files/create.sql" or die $!;
 478         <CREATE>;
 479     };
 480     $tr->data(\$create_script);
 481
 482 B<filename> takes a string, which is interpreted as a filename.
 483 B<data> takes a reference to a string, which is used as the data to be
 484 parsed.  If a filename is set, then that file is opened and read when
 485 the B<translate> method is called, as long as the data instance
 486 variable is not set.
 487
 488 =cut
 489
 490 # filename - get or set the filename
 491 sub filename {
 492     my $self = shift;
 493     if (@_) {
 494         my $filename = shift;
 495         if (-d $filename) {
 496             my $msg = "Cannot use directory '$filename' as input source";
 497             $self->error_out($msg);
 498             return;
 499         } elsif (-f _ && -r _) {
 500             $self->{'filename'} = $filename;
 501             $self->debug("Got filename: $self->{'filename'}");
 502         } else {
 503             my $msg = "Cannot use '$filename' as input source: ".
 504                       "file does not exist or is not readable.";
 505             $self->error_out($msg);
 506             return;
 507         }
 508     }
 509
 510     $self->{'filename'};
 511 }
 512
 513 # data - get or set the data
 514 # if $self->{'data'} is not set, but $self->{'filename'} is, then
 515 # $self->{'filename'} is opened and read, whith the results put into
 516 # $self->{'data'}.
 517 sub data {
 518     my $self = shift;
 519
 520     # Set $self->{'data'} to $_[0], if it is provided.
 521     if (@_) {
 522         my $data = shift;
 523         if (isa($data, "SCALAR")) {
 524             $self->{'data'} =  $data;
 525         }
 526         elsif (! ref $data) {
 527             $self->{'data'} = \$data;
 528         }
 529     }
 530
 531     # If we have a filename but no data yet, populate.
 532     if (not $self->{'data'} and my $filename = $self->filename) {
 533         $self->debug("Opening '$filename' to get contents...");
 534         local *FH;
 535         local $/;
 536         my $data;
 537
 538         unless (open FH, $filename) {
 539             $self->error_out("Can't open $filename for reading: $!");
 540             return;
 541         }
 542
 543         $data = <FH>;
 544         $self->{'data'} = \$data;
 545
 546         unless (close FH) {
 547             $self->error_out("Can't close $filename: $!");
 548             return;
 549         }
 550     }
 551
 552     return $self->{'data'};
 553 }
 554
 555 # translate
 556 sub translate {
 557     my $self = shift;
 558     my ($args, $parser, $parser_type, $producer, $producer_type);
 559     my ($parser_output, $producer_output);
 560
 561     # Parse arguments
 562     if (@_ == 1) {
 563         # Passed a reference to a hash?
 564         if (isa($_[0], 'HASH')) {
 565             # yep, a hashref
 566             $self->debug("translate: Got a hashref");
 567             $args = $_[0];
 568         }
 569
 570         # Passed a reference to a string containing the data
 571         elsif (isa($_[0], 'SCALAR')) {
 572             # passed a ref to a string
 573             $self->debug("translate: Got a SCALAR reference (string)");
 574             $self->data($_[0]);
 575         }
 576
 577         # Not a reference; treat it as a filename
 578         elsif (! ref $_[0]) {
 579             # Not a ref, it's a filename
 580             $self->debug("translate: Got a filename");
 581             $self->filename($_[0]);
 582         }
 583
 584         # Passed something else entirely.
 585         else {
 586             # We're not impressed.  Take your empty string and leave.
 587             # return "";
 588
 589             # Actually, if data, parser, and producer are set, then we
 590             # can continue.  Too bad, because I like my comment
 591             # (above)...
 592             return "" unless ($self->data     &&
 593                               $self->producer &&
 594                               $self->parser);
 595         }
 596     }
 597     else {
 598         # You must pass in a hash, or you get nothing.
 599         return "" if @_ % 2;
 600         $args = { @_ };
 601     }
 602
 603     # ----------------------------------------------------------------------
 604     # Can specify the data to be transformed using "filename", "file",
 605     # "data", or "datasource".
 606     # ----------------------------------------------------------------------
 607     if (my $filename = ($args->{'filename'} || $args->{'file'})) {
 608         $self->filename($filename);
 609     }
 610
 611     if (my $data = ($self->{'data'} || $self->{'datasource'})) {
 612         $self->data($data);
 613     }
 614
 615     # ----------------------------------------------------------------
 616     # Get the data.
 617     # ----------------------------------------------------------------
 618     my $data = $self->data;
 619     unless (length $$data) {
 620         $self->error_out("Empty data file!");
 621         return "";
 622     }
 623
 624     # ----------------------------------------------------------------
 625     # Local reference to the parser subroutine
 626     # ----------------------------------------------------------------
 627     if ($parser = ($args->{'parser'} || $args->{'from'})) {
 628         $self->parser($parser);
 629     }
 630     $parser      = $self->parser;
 631     $parser_type = $self->parser_type;
 632
 633     # ----------------------------------------------------------------
 634     # Local reference to the producer subroutine
 635     # ----------------------------------------------------------------
 636     if ($producer = ($args->{'producer'} || $args->{'to'})) {
 637         $self->producer($producer);
 638     }
 639     $producer      = $self->producer;
 640     $producer_type = $self->producer_type;
 641
 642     # ----------------------------------------------------------------
 643     # Execute the parser, then execute the producer with that output.
 644     # Allowances are made for each piece to die, or fail to compile,
 645     # since the referenced subroutines could be almost anything.  In
 646     # the future, each of these might happen in a Safe environment,
 647     # depending on how paranoid we want to be.
 648     # ----------------------------------------------------------------
 649     eval { $parser_output = $parser->($self, $$data) };
 650     if ($@ || ! $parser_output) {
 651         my $msg = sprintf "translate: Error with parser '%s': %s",
 652             $parser_type, ($@) ? $@ : " no results";
 653         $self->error_out($msg);
 654         return;
 655     }
 656
 657     eval { $producer_output = $producer->($self, $parser_output) };
 658     if ($@ || ! $producer_output) {
 659         my $msg = sprintf "translate: Error with producer '%s': %s",
 660             $producer_type, ($@) ? $@ : " no results";
 661         $self->error_out($msg);
 662         return;
 663     }
 664
 665     return $producer_output;
 666 }
 667
 668 =head2 B<error>
 669
 670 The error method returns the last error.
 671
 672 =cut
 673
 674 #-----------------------------------------------------
 675 sub error {
 676 #
 677 # Return the last error.
 678 #
 679     return shift()->{'error'} || '';
 680 }
 681
 682 =head2 B<error_out>
 683
 684 Record the error and return undef.  The error can be retrieved by
 685 calling programs using $tr->error.
 686
 687 For Parser or Producer writers, primarily.
 688
 689 =cut
 690
 691 # error_out
 692 sub error_out {
 693     my $self = shift;
 694     if ( my $error = shift ) {
 695         $self->{'error'} = $error;
 696     }
 697     return;
 698 }
 699
 700 =head2 B<debug>
 701
 702 If the global variable $SQL::Translator::DEBUG is set to a true value,
 703 then calls to $tr->debug($msg) will be carped to STDERR.  If $DEBUG is
 704 not set, then this method does nothing.
 705
 706 =cut
 707
 708 # debug
 709 sub debug {
 710     my $self = shift;
 711 #    if (ref $self) {
 712 #        carp @_ if $self->{'debug'};
 713 #    }
 714 #    else {
 715         if ($DEBUG) {
 716             my $class = ref $self || $self;
 717             carp "[$class] $_" for @_;
 718         }
 719 #    }
 720 }
 721
 722 sub load {
 723     my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" };
 724     return 1 if $INC{$module};
 725
 726     eval { require $module };
 727
 728     return if ($@);
 729     return 1;
 730 }
 731
 732 1;
 733
 734 __END__
 735 #-----------------------------------------------------
 736 # Rescue the drowning and tie your shoestrings.
 737 # Henry David Thoreau
 738 #-----------------------------------------------------
 739
 740 =head1 AUTHORS
 741
 742 Ken Y. Clark, E<lt>kclark@logsoft.comE<gt>,
 743 darren chamberlain E<lt>darren@cpan.orgE<gt>
 744
 745 =head1 COPYRIGHT
 746
 747 This program is free software; you can redistribute it and/or modify
 748 it under the terms of the GNU General Public License as published by
 749 the Free Software Foundation; version 2.
 750
 751 This program is distributed in the hope that it will be useful, but
 752 WITHOUT ANY WARRANTY; without even the implied warranty of
 753 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 754 General Public License for more details.
 755
 756 You should have received a copy of the GNU General Public License
 757 along with this program; if not, write to the Free Software
 758 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
 759 USA
 760
 761 =head1 SEE ALSO
 762
 763 L<perl>, L<Parse::RecDescent>
 764
 765 =cut