lib/DBIx/Class/Schema.pm

   1 package DBIx::Class::Schema;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp::Clan qw/^DBIx::Class/;
   7 use Scalar::Util qw/weaken/;
   8
   9 use base qw/DBIx::Class/;
  10
  11 __PACKAGE__->mk_classdata('class_mappings' => {});
  12 __PACKAGE__->mk_classdata('source_registrations' => {});
  13 __PACKAGE__->mk_classdata('storage_type' => '::DBI');
  14 __PACKAGE__->mk_classdata('storage');
  15 __PACKAGE__->mk_classdata('exception_action');
  16
  17 =head1 NAME
  18
  19 DBIx::Class::Schema - composable schemas
  20
  21 =head1 SYNOPSIS
  22
  23   package Library::Schema;
  24   use base qw/DBIx::Class::Schema/;
  25
  26   # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
  27   __PACKAGE__->load_classes(qw/CD Book DVD/);
  28
  29   package Library::Schema::CD;
  30   use base qw/DBIx::Class/;
  31   __PACKAGE__->load_components(qw/PK::Auto Core/); # for example
  32   __PACKAGE__->table('cd');
  33
  34   # Elsewhere in your code:
  35   my $schema1 = Library::Schema->connect(
  36     $dsn,
  37     $user,
  38     $password,
  39     { AutoCommit => 0 },
  40   );
  41
  42   my $schema2 = Library::Schema->connect($coderef_returning_dbh);
  43
  44   # fetch objects using Library::Schema::DVD
  45   my $resultset = $schema1->resultset('DVD')->search( ... );
  46   my @dvd_objects = $schema2->resultset('DVD')->search( ... );
  47
  48 =head1 DESCRIPTION
  49
  50 Creates database classes based on a schema. This is the recommended way to
  51 use L<DBIx::Class> and allows you to use more than one concurrent connection
  52 with your classes.
  53
  54 NB: If you're used to L<Class::DBI> it's worth reading the L</SYNOPSIS>
  55 carefully, as DBIx::Class does things a little differently. Note in
  56 particular which module inherits off which.
  57
  58 =head1 METHODS
  59
  60 =head2 register_class
  61
  62 =over 4
  63
  64 =item Arguments: $moniker, $component_class
  65
  66 =back
  67
  68 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
  69 calling:
  70
  71   $schema->register_source($moniker, $component_class->result_source_instance);
  72
  73 =cut
  74
  75 sub register_class {
  76   my ($self, $moniker, $to_register) = @_;
  77   $self->register_source($moniker => $to_register->result_source_instance);
  78 }
  79
  80 =head2 register_source
  81
  82 =over 4
  83
  84 =item Arguments: $moniker, $result_source
  85
  86 =back
  87
  88 Registers the L<DBIx::Class::ResultSource> in the schema with the given
  89 moniker.
  90
  91 =cut
  92
  93 sub register_source {
  94   my ($self, $moniker, $source) = @_;
  95   my %reg = %{$self->source_registrations};
  96   $reg{$moniker} = $source;
  97   $self->source_registrations(\%reg);
  98   $source->schema($self);
  99   weaken($source->{schema}) if ref($self);
 100   if ($source->result_class) {
 101     my %map = %{$self->class_mappings};
 102     $map{$source->result_class} = $moniker;
 103     $self->class_mappings(\%map);
 104   }
 105 }
 106
 107 =head2 class
 108
 109 =over 4
 110
 111 =item Arguments: $moniker
 112
 113 =item Return Value: $classname
 114
 115 =back
 116
 117 Retrieves the result class name for the given moniker. For example:
 118
 119   my $class = $schema->class('CD');
 120
 121 =cut
 122
 123 sub class {
 124   my ($self, $moniker) = @_;
 125   return $self->source($moniker)->result_class;
 126 }
 127
 128 =head2 source
 129
 130 =over 4
 131
 132 =item Arguments: $moniker
 133
 134 =item Return Value: $result_source
 135
 136 =back
 137
 138   my $source = $schema->source('Book');
 139
 140 Returns the L<DBIx::Class::ResultSource> object for the registered moniker.
 141
 142 =cut
 143
 144 sub source {
 145   my ($self, $moniker) = @_;
 146   my $sreg = $self->source_registrations;
 147   return $sreg->{$moniker} if exists $sreg->{$moniker};
 148
 149   # if we got here, they probably passed a full class name
 150   my $mapped = $self->class_mappings->{$moniker};
 151   $self->throw_exception("Can't find source for ${moniker}")
 152     unless $mapped && exists $sreg->{$mapped};
 153   return $sreg->{$mapped};
 154 }
 155
 156 =head2 sources
 157
 158 =over 4
 159
 160 =item Return Value: @source_monikers
 161
 162 =back
 163
 164 Returns the source monikers of all source registrations on this schema.
 165 For example:
 166
 167   my @source_monikers = $schema->sources;
 168
 169 =cut
 170
 171 sub sources { return keys %{shift->source_registrations}; }
 172
 173 =head2 resultset
 174
 175 =over 4
 176
 177 =item Arguments: $moniker
 178
 179 =item Return Value: $result_set
 180
 181 =back
 182
 183   my $rs = $schema->resultset('DVD');
 184
 185 Returns the L<DBIx::Class::ResultSet> object for the registered moniker.
 186
 187 =cut
 188
 189 sub resultset {
 190   my ($self, $moniker) = @_;
 191   return $self->source($moniker)->resultset;
 192 }
 193
 194 =head2 load_classes
 195
 196 =over 4
 197
 198 =item Arguments: @classes?, { $namespace => [ @classes ] }+
 199
 200 =back
 201
 202 With no arguments, this method uses L<Module::Find> to find all classes under
 203 the schema's namespace. Otherwise, this method loads the classes you specify
 204 (using L<use>), and registers them (using L</"register_class">).
 205
 206 It is possible to comment out classes with a leading C<#>, but note that perl
 207 will think it's a mistake (trying to use a comment in a qw list), so you'll
 208 need to add C<no warnings 'qw';> before your load_classes call.
 209
 210 Example:
 211
 212   My::Schema->load_classes(); # loads My::Schema::CD, My::Schema::Artist,
 213                               # etc. (anything under the My::Schema namespace)
 214
 215   # loads My::Schema::CD, My::Schema::Artist, Other::Namespace::Producer but
 216   # not Other::Namespace::LinerNotes nor My::Schema::Track
 217   My::Schema->load_classes(qw/ CD Artist #Track /, {
 218     Other::Namespace => [qw/ Producer #LinerNotes /],
 219   });
 220
 221 =cut
 222
 223 sub load_classes {
 224   my ($class, @params) = @_;
 225
 226   my %comps_for;
 227
 228   if (@params) {
 229     foreach my $param (@params) {
 230       if (ref $param eq 'ARRAY') {
 231         # filter out commented entries
 232         my @modules = grep { $_ !~ /^#/ } @$param;
 233
 234         push (@{$comps_for{$class}}, @modules);
 235       }
 236       elsif (ref $param eq 'HASH') {
 237         # more than one namespace possible
 238         for my $comp ( keys %$param ) {
 239           # filter out commented entries
 240           my @modules = grep { $_ !~ /^#/ } @{$param->{$comp}};
 241
 242           push (@{$comps_for{$comp}}, @modules);
 243         }
 244       }
 245       else {
 246         # filter out commented entries
 247         push (@{$comps_for{$class}}, $param) if $param !~ /^#/;
 248       }
 249     }
 250   } else {
 251     eval "require Module::Find;";
 252     $class->throw_exception(
 253       "No arguments to load_classes and couldn't load Module::Find ($@)"
 254     ) if $@;
 255     my @comp = map { substr $_, length "${class}::"  }
 256                  Module::Find::findallmod($class);
 257     $comps_for{$class} = \@comp;
 258   }
 259
 260   my @to_register;
 261   {
 262     no warnings qw/redefine/;
 263     local *Class::C3::reinitialize = sub { };
 264     foreach my $prefix (keys %comps_for) {
 265       foreach my $comp (@{$comps_for{$prefix}||[]}) {
 266         my $comp_class = "${prefix}::${comp}";
 267         $class->ensure_class_loaded($comp_class);
 268         $comp_class->source_name($comp) unless $comp_class->source_name;
 269
 270         push(@to_register, [ $comp_class->source_name, $comp_class ]);
 271       }
 272     }
 273   }
 274   Class::C3->reinitialize;
 275
 276   foreach my $to (@to_register) {
 277     $class->register_class(@$to);
 278     #  if $class->can('result_source_instance');
 279   }
 280 }
 281
 282 =head2 compose_connection
 283
 284 =over 4
 285
 286 =item Arguments: $target_namespace, @db_info
 287
 288 =item Return Value: $new_schema
 289
 290 =back
 291
 292 Calls L<DBIx::Class::Schema/"compose_namespace"> to the target namespace,
 293 calls L<DBIx::Class::Schema/connection> with @db_info on the new schema,
 294 then injects the L<DBix::Class::ResultSetProxy> component and a
 295 resultset_instance classdata entry on all the new classes, in order to support
 296 $target_namespaces::$class->search(...) method calls.
 297
 298 This is primarily useful when you have a specific need for class method access
 299 to a connection. In normal usage it is preferred to call
 300 L<DBIx::Class::Schema/connect> and use the resulting schema object to operate
 301 on L<DBIx::Class::ResultSet> objects with L<DBIx::Class::Schema/resultset> for
 302 more information.
 303
 304 =cut
 305
 306 sub compose_connection {
 307   my ($self, $target, @info) = @_;
 308   my $base = 'DBIx::Class::ResultSetProxy';
 309   eval "require ${base};";
 310   $self->throw_exception
 311     ("No arguments to load_classes and couldn't load ${base} ($@)")
 312       if $@;
 313
 314   if ($self eq $target) {
 315     # Pathological case, largely caused by the docs on early C::M::DBIC::Plain
 316     foreach my $moniker ($self->sources) {
 317       my $source = $self->source($moniker);
 318       my $class = $source->result_class;
 319       $self->inject_base($class, $base);
 320       $class->mk_classdata(resultset_instance => $source->resultset);
 321       $class->mk_classdata(class_resolver => $self);
 322     }
 323     $self->connection(@info);
 324     return $self;
 325   }
 326
 327   my $schema = $self->compose_namespace($target, $base);
 328   {
 329     no strict 'refs';
 330     *{"${target}::schema"} = sub { $schema };
 331   }
 332
 333   $schema->connection(@info);
 334   foreach my $moniker ($schema->sources) {
 335     my $source = $schema->source($moniker);
 336     my $class = $source->result_class;
 337     #warn "$moniker $class $source ".$source->storage;
 338     $class->mk_classdata(result_source_instance => $source);
 339     $class->mk_classdata(resultset_instance => $source->resultset);
 340     $class->mk_classdata(class_resolver => $schema);
 341   }
 342   return $schema;
 343 }
 344
 345 =head2 compose_namespace
 346
 347 =over 4
 348
 349 =item Arguments: $target_namespace, $additional_base_class?
 350
 351 =item Return Value: $new_schema
 352
 353 =back
 354
 355 For each L<DBIx::Class::ResultSource> in the schema, this method creates a
 356 class in the target namespace (e.g. $target_namespace::CD,
 357 $target_namespace::Artist) that inherits from the corresponding classes
 358 attached to the current schema.
 359
 360 It also attaches a corresponding L<DBIx::Class::ResultSource> object to the
 361 new $schema object. If C<$additional_base_class> is given, the new composed
 362 classes will inherit from first the corresponding classe from the current
 363 schema then the base class.
 364
 365 For example, for a schema with My::Schema::CD and My::Schema::Artist classes,
 366
 367   $schema->compose_namespace('My::DB', 'Base::Class');
 368   print join (', ', @My::DB::CD::ISA) . "\n";
 369   print join (', ', @My::DB::Artist::ISA) ."\n";
 370
 371 will produce the output
 372
 373   My::Schema::CD, Base::Class
 374   My::Schema::Artist, Base::Class
 375
 376 =cut
 377
 378 sub compose_namespace {
 379   my ($self, $target, $base) = @_;
 380   my %reg = %{ $self->source_registrations };
 381   my %target;
 382   my %map;
 383   my $schema = $self->clone;
 384   {
 385     no warnings qw/redefine/;
 386     local *Class::C3::reinitialize = sub { };
 387     foreach my $moniker ($schema->sources) {
 388       my $source = $schema->source($moniker);
 389       my $target_class = "${target}::${moniker}";
 390       $self->inject_base(
 391         $target_class => $source->result_class, ($base ? $base : ())
 392       );
 393       $source->result_class($target_class);
 394       $target_class->result_source_instance($source)
 395         if $target_class->can('result_source_instance');
 396     }
 397   }
 398   Class::C3->reinitialize();
 399   {
 400     no strict 'refs';
 401     foreach my $meth (qw/class source resultset/) {
 402       *{"${target}::${meth}"} =
 403         sub { shift->schema->$meth(@_) };
 404     }
 405   }
 406   return $schema;
 407 }
 408
 409 =head2 setup_connection_class
 410
 411 =over 4
 412
 413 =item Arguments: $target, @info
 414
 415 =back
 416
 417 Sets up a database connection class to inject between the schema and the
 418 subclasses that the schema creates.
 419
 420 =cut
 421
 422 sub setup_connection_class {
 423   my ($class, $target, @info) = @_;
 424   $class->inject_base($target => 'DBIx::Class::DB');
 425   #$target->load_components('DB');
 426   $target->connection(@info);
 427 }
 428
 429 =head2 connection
 430
 431 =over 4
 432
 433 =item Arguments: @args
 434
 435 =item Return Value: $new_schema
 436
 437 =back
 438
 439 Instantiates a new Storage object of type
 440 L<DBIx::Class::Schema/"storage_type"> and passes the arguments to
 441 $storage->connect_info. Sets the connection in-place on the schema. See
 442 L<DBIx::Class::Storage::DBI/"connect_info"> for more information.
 443
 444 =cut
 445
 446 sub connection {
 447   my ($self, @info) = @_;
 448   return $self if !@info && $self->storage;
 449   my $storage_class = $self->storage_type;
 450   $storage_class = 'DBIx::Class::Storage'.$storage_class
 451     if $storage_class =~ m/^::/;
 452   eval "require ${storage_class};";
 453   $self->throw_exception(
 454     "No arguments to load_classes and couldn't load ${storage_class} ($@)"
 455   ) if $@;
 456   my $storage = $storage_class->new($self);
 457   $storage->connect_info(\@info);
 458   $self->storage($storage);
 459   return $self;
 460 }
 461
 462 =head2 connect
 463
 464 =over 4
 465
 466 =item Arguments: @info
 467
 468 =item Return Value: $new_schema
 469
 470 =back
 471
 472 This is a convenience method. It is equivalent to calling
 473 $schema->clone->connection(@info). See L</connection> and L</clone> for more
 474 information.
 475
 476 =cut
 477
 478 sub connect { shift->clone->connection(@_) }
 479
 480 =head2 txn_begin
 481
 482 Begins a transaction (does nothing if AutoCommit is off). Equivalent to
 483 calling $schema->storage->txn_begin. See
 484 L<DBIx::Class::Storage::DBI/"txn_begin"> for more information.
 485
 486 =cut
 487
 488 sub txn_begin { shift->storage->txn_begin }
 489
 490 =head2 txn_commit
 491
 492 Commits the current transaction. Equivalent to calling
 493 $schema->storage->txn_commit. See L<DBIx::Class::Storage::DBI/"txn_commit">
 494 for more information.
 495
 496 =cut
 497
 498 sub txn_commit { shift->storage->txn_commit }
 499
 500 =head2 txn_rollback
 501
 502 Rolls back the current transaction. Equivalent to calling
 503 $schema->storage->txn_rollback. See
 504 L<DBIx::Class::Storage::DBI/"txn_rollback"> for more information.
 505
 506 =cut
 507
 508 sub txn_rollback { shift->storage->txn_rollback }
 509
 510 =head2 txn_do
 511
 512 =over 4
 513
 514 =item Arguments: C<$coderef>, @coderef_args?
 515
 516 =item Return Value: The return value of $coderef
 517
 518 =back
 519
 520 Executes C<$coderef> with (optional) arguments C<@coderef_args> atomically,
 521 returning its result (if any). If an exception is caught, a rollback is issued
 522 and the exception is rethrown. If the rollback fails, (i.e. throws an
 523 exception) an exception is thrown that includes a "Rollback failed" message.
 524
 525 For example,
 526
 527   my $author_rs = $schema->resultset('Author')->find(1);
 528   my @titles = qw/Night Day It/;
 529
 530   my $coderef = sub {
 531     # If any one of these fails, the entire transaction fails
 532     $author_rs->create_related('books', {
 533       title => $_
 534     }) foreach (@titles);
 535
 536     return $author->books;
 537   };
 538
 539   my $rs;
 540   eval {
 541     $rs = $schema->txn_do($coderef);
 542   };
 543
 544   if ($@) {                                  # Transaction failed
 545     die "something terrible has happened!"   #
 546       if ($@ =~ /Rollback failed/);          # Rollback failed
 547
 548     deal_with_failed_transaction();
 549   }
 550
 551 In a nested transaction (calling txn_do() from within a txn_do() coderef) only
 552 the outermost transaction will issue a L<DBIx::Class::Schema/"txn_commit"> on
 553 the Schema's storage, and txn_do() can be called in void, scalar and list
 554 context and it will behave as expected.
 555
 556 =cut
 557
 558 sub txn_do {
 559   my ($self, $coderef, @args) = @_;
 560
 561   $self->storage or $self->throw_exception
 562     ('txn_do called on $schema without storage');
 563   ref $coderef eq 'CODE' or $self->throw_exception
 564     ('$coderef must be a CODE reference');
 565
 566   my (@return_values, $return_value);
 567
 568   $self->txn_begin; # If this throws an exception, no rollback is needed
 569
 570   my $wantarray = wantarray; # Need to save this since the context
 571                              # inside the eval{} block is independent
 572                              # of the context that called txn_do()
 573   eval {
 574
 575     # Need to differentiate between scalar/list context to allow for
 576     # returning a list in scalar context to get the size of the list
 577     if ($wantarray) {
 578       # list context
 579       @return_values = $coderef->(@args);
 580     } elsif (defined $wantarray) {
 581       # scalar context
 582       $return_value = $coderef->(@args);
 583     } else {
 584       # void context
 585       $coderef->(@args);
 586     }
 587     $self->txn_commit;
 588   };
 589
 590   if ($@) {
 591     my $error = $@;
 592
 593     eval {
 594       $self->txn_rollback;
 595     };
 596
 597     if ($@) {
 598       my $rollback_error = $@;
 599       my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
 600       $self->throw_exception($error)  # propagate nested rollback
 601         if $rollback_error =~ /$exception_class/;
 602
 603       $self->throw_exception(
 604         "Transaction aborted: $error. Rollback failed: ${rollback_error}"
 605       );
 606     } else {
 607       $self->throw_exception($error); # txn failed but rollback succeeded
 608     }
 609   }
 610
 611   return $wantarray ? @return_values : $return_value;
 612 }
 613
 614 =head2 clone
 615
 616 =over 4
 617
 618 =item Return Value: $new_schema
 619
 620 =back
 621
 622 Clones the schema and its associated result_source objects and returns the
 623 copy.
 624
 625 =cut
 626
 627 sub clone {
 628   my ($self) = @_;
 629   my $clone = { (ref $self ? %$self : ()) };
 630   bless $clone, (ref $self || $self);
 631
 632   foreach my $moniker ($self->sources) {
 633     my $source = $self->source($moniker);
 634     my $new = $source->new($source);
 635     $clone->register_source($moniker => $new);
 636   }
 637   $clone->storage->set_schema($clone) if $clone->storage;
 638   return $clone;
 639 }
 640
 641 =head2 populate
 642
 643 =over 4
 644
 645 =item Arguments: $moniker, \@data;
 646
 647 =back
 648
 649 Populates the source registered with the given moniker with the supplied data.
 650 @data should be a list of listrefs -- the first containing column names, the
 651 second matching values.
 652
 653 i.e.,
 654
 655   $schema->populate('Artist', [
 656     [ qw/artistid name/ ],
 657     [ 1, 'Popular Band' ],
 658     [ 2, 'Indie Band' ],
 659     ...
 660   ]);
 661
 662 =cut
 663
 664 sub populate {
 665   my ($self, $name, $data) = @_;
 666   my $rs = $self->resultset($name);
 667   my @names = @{shift(@$data)};
 668   my @created;
 669   foreach my $item (@$data) {
 670     my %create;
 671     @create{@names} = @$item;
 672     push(@created, $rs->create(\%create));
 673   }
 674   return @created;
 675 }
 676
 677 =head2 exception_action
 678
 679 =over 4
 680
 681 =item Arguments: $code_reference
 682
 683 =back
 684
 685 If C<exception_action> is set for this class/object, L</throw_exception>
 686 will prefer to call this code reference with the exception as an argument,
 687 rather than its normal <croak> action.
 688
 689 Your subroutine should probably just wrap the error in the exception
 690 object/class of your choosing and rethrow.  If, against all sage advice,
 691 you'd like your C<exception_action> to suppress a particular exception
 692 completely, simply have it return true.
 693
 694 Example:
 695
 696    package My::Schema;
 697    use base qw/DBIx::Class::Schema/;
 698    use My::ExceptionClass;
 699    __PACKAGE__->exception_action(sub { My::ExceptionClass->throw(@_) });
 700    __PACKAGE__->load_classes;
 701
 702    # or:
 703    my $schema_obj = My::Schema->connect( .... );
 704    $schema_obj->exception_action(sub { My::ExceptionClass->throw(@_) });
 705
 706    # suppress all exceptions, like a moron:
 707    $schema_obj->exception_action(sub { 1 });
 708
 709 =head2 throw_exception
 710
 711 =over 4
 712
 713 =item Arguments: $message
 714
 715 =back
 716
 717 Throws an exception. Defaults to using L<Carp::Clan> to report errors from
 718 user's perspective.  See L</exception_action> for details on overriding
 719 this method's behavior.
 720
 721 =cut
 722
 723 sub throw_exception {
 724   my $self = shift;
 725   croak @_ if !$self->exception_action || !$self->exception_action->(@_);
 726 }
 727
 728 =head2 deploy (EXPERIMENTAL)
 729
 730 =over 4
 731
 732 =item Arguments: $sqlt_args
 733
 734 =back
 735
 736 Attempts to deploy the schema to the current storage using L<SQL::Translator>.
 737
 738 Note that this feature is currently EXPERIMENTAL and may not work correctly
 739 across all databases, or fully handle complex relationships.
 740
 741 See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>. The most
 742 common value for this would be C<< { add_drop_table => 1, } >> to have the SQL
 743 produced include a DROP TABLE statement for each table created.
 744
 745 =cut
 746
 747 sub deploy {
 748   my ($self, $sqltargs) = @_;
 749   $self->throw_exception("Can't deploy without storage") unless $self->storage;
 750   $self->storage->deploy($self, undef, $sqltargs);
 751 }
 752
 753 =head2 create_ddl_dir (EXPERIMENTAL)
 754
 755 =over 4
 756
 757 =item Arguments: \@databases, $version, $directory, $sqlt_args
 758
 759 =back
 760
 761 Creates an SQL file based on the Schema, for each of the specified
 762 database types, in the given directory.
 763
 764 Note that this feature is currently EXPERIMENTAL and may not work correctly
 765 across all databases, or fully handle complex relationships.
 766
 767 =cut
 768
 769 sub create_ddl_dir
 770 {
 771   my $self = shift;
 772
 773   $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
 774   $self->storage->create_ddl_dir($self, @_);
 775 }
 776
 777 =head2 ddl_filename (EXPERIMENTAL)
 778
 779   my $filename = $table->ddl_filename($type, $dir, $version)
 780
 781 Creates a filename for a SQL file based on the table class name.  Not
 782 intended for direct end user use.
 783
 784 =cut
 785
 786 sub ddl_filename
 787 {
 788     my ($self, $type, $dir, $version) = @_;
 789
 790     my $filename = ref($self);
 791     $filename =~ s/::/-/;
 792     $filename = "$dir$filename-$version-$type.sql";
 793
 794     return $filename;
 795 }
 796
 797 1;
 798
 799 =head1 AUTHORS
 800
 801 Matt S. Trout <mst@shadowcatsystems.co.uk>
 802
 803 =head1 LICENSE
 804
 805 You may distribute this code under the same terms as Perl itself.
 806
 807 =cut
 808