File Coverage

blib/lib/WARC/Record.pm

Criterion	Covered	Total	%
statement	70	70	100.0
branch	17	18	94.4
condition			n/a
subroutine	27	27	100.0
pod	19	19	100.0
total	133	134	99.2

package WARC::Record;						# -*- CPerl -*-

use strict;
use warnings;

use Carp;
use Scalar::Util;

our @ISA = qw();

require WARC; *WARC::Record::VERSION = \$WARC::VERSION;
require WARC::Date;

=head1 NAME

WARC::Record - one record from a WARC file

=head1 SYNOPSIS

  use WARC;		# or ...
  use WARC::Volume;	# or ...
  use WARC::Collection;

  # WARC::Record objects are returned from ->record_at and ->search methods

  # Construct a record, as when preparing a WARC file
  $warcinfo = new WARC::Record (type => 'warcinfo');

  # Accessors

  $value = $record->field($name);

  $version = $record->protocol;	# analogous to HTTP::Message::protocol
  $volume = $record->volume;
  $offset = $record->offset;
  $record = $record->next;

  $fields = $record->fields;

  # Supply a data block for an in-memory record
  $warcinfo->block(new WARC::Fields ( ... ));

=cut

use overload '<=>' => 'compareTo', 'cmp' => 'compareTo';
use overload fallback => 1;

# This implementation uses a hash as the underlying object.
#  Keys defined by this class:
#
#   fields
#	Embedded WARC::Fields object
#
#  Keys defined by this class but overridden and unused in subclasses:
#
#   block
#	Data block for this record

sub _dbg_dump {
  my $self = shift;

  my $out = "WARC record [dumping as base class]\n";
  my @out = map {s/^/  /gm; $_} $self->fields->as_string;
  $out .= join("\n", @out);

  return $out;
}

=head1 DESCRIPTION

C objects come in two flavors with a common interface.
Records read from WARC files are read-only and have meaningful return
values from the methods listed in "Methods on records from WARC files".
Records constructed in memory can be updated and those same methods all
return undef.

=head2 Common Methods

=over

=item $record-Efields

Get the internal C object that contains WARC record headers.

=cut

sub fields { (shift)->{fields} }

=item $record-Efield( $name )

Get the value of the WARC header named $name from the internal
C object.

=cut

sub field {
  my $self = shift;
  return $self->fields->field(shift);
}

=item $record E=E $other_record

=item $record-EcompareTo( $other_record )

Compare two C objects according to a simple total order:
ordering by starting offset for two records in the same file, and by
filename of the containing C objects for records in different
files.  Constructed C objects are assumed to come from a
volume named "" (the empty string) for this purpose, and are ordered in an
arbitrary but stable manner amongst themselves.  Distinct constructed
C objects never compare as equal.

Perl constructs a C<==> operator using this method, so WARC record objects
will compare as equal iff they refer to the same physical record.

=cut

sub compareTo {
  my $a = shift;
  my $b = shift;
  my $swap = shift;

  # sort in-memory-only records ahead of on-disk records
  return $swap ? 1 : -1 if defined $b->volume;

  # neither record is from a WARC volume
  my $cmp = (Scalar::Util::refaddr $a) <=> (Scalar::Util::refaddr $b);

  return $swap ? 0-$cmp : 0+$cmp;
}

=back

=head3 Convenience getters

=over

=item $record-Etype

Alias for C<$record-Efield('WARC-Type')>.

=cut

sub type { (shift)->field('WARC-Type') }

=item $record-Eid

Alias for C<$record-Efield('WARC-Record-ID')>.

=cut

sub id { (shift)->field('WARC-Record-ID') }

=item $record-Econtent_length

Alias for C<$record-Efield('Content-Length')>.

=cut

sub content_length { (shift)->field('Content-Length') }

=item $record-Edate

Return the C<'WARC-Date'> field as a C object.

=cut

sub date { WARC::Date->from_string((shift)->field('WARC-Date')) }

=back

=head2 Methods on records from WARC files

These methods all return undef if called on a C object that
does not represent a record in a WARC file.

=over

=item $record-Eprotocol

Return the format and version tag for this record.  For WARC 1.0, this
method returns 'WARC/1.0'.

=cut

sub protocol { return undef }

=item $record-Evolume

Return the C object representing the file in which this
record is located.

=cut

sub volume { return undef }

=item $record-Eoffset

Return the file offset at which this record can be found.

=cut

sub offset { return undef }

=item $record-Elogical

Return the logical record object for this record.  Logical records
reassemble WARC continuation segments.  Records recorded without using WARC
segmentation are their own logical records.  Reassembled logical records
are also their own logical records.

=cut

sub logical { return undef }

=item $record-Esegments

Return a list of segments for this record.  A record recorded without using
WARC segmentation, including a segment of a larger logical record, is
considered its own only segment.  A constructed record is considered to
have no segments at all.

This method exists on all records to allow
C<$record-Elogical-Esegments> to work.

=cut

sub segments { return () }

=item $record-Enext

Return the next C in the WARC file that contains this record.
Returns an undefined value if called on the last record in a file.

=cut

sub next { return undef }

=item $record-Eopen_block

Return a tied filehandle that reads the WARC record block.

The WARC record block is the content of a WARC record, analogous to the
entity body in an C.

=cut

sub open_block { return undef }

=item $record-Eopen_continued

Return a tied filehandle that reads the logical WARC record block.

For records that do not use WARC segmentation, this is effectively an alias
for C<$record-Eopen_block>.  For records that span multiple segments,
this is an alias for C<$record-Elogical-Eopen_block>.

=cut

sub open_continued { return undef }

=item $record-Ereplay

=item $record-Ereplay( as =E $type )

Return a protocol-specific object representing the record contents.

This method returns undef if the library does not recognize the protocol
message stored in the record and croaks if a requested conversion is not
supported.

A record with Content-Type "application/http" with an appropriate "msgtype"
parameter produces an C or C object.  The
returned object may be a subclass to support deferred loading of entity
bodies.

A request to replay a record "as =E http" attempts to convert whatever
is stored in the record to an HTTP exchange, analogous to the "everything
is HTTP" interface that C provides.

=cut

sub replay { return undef }

=item $record-Eopen_payload

Return a tied filehandle that reads the WARC record payload.

The WARC record payload is defined as the decoded content of the protocol
response or other resource stored in the record.  This method returns undef
if called on a WARC record that has no payload or that has content that we
do not recognize.

=cut

sub open_payload { return undef }

=back

=head2 Methods on fresh WARC records

=over

=item $record = new WARC::Record (I =E I, ...)

Construct a fresh WARC record, suitable for use with C.

=cut

sub new {
  my $class = shift;
  my %opt = @_;

  foreach my $name (qw/type/)
    { croak "required field '$name' not specified" unless $opt{$name} }

  my $fields = new WARC::Fields ('WARC-Type' => $opt{type});

  bless { fields => $fields }, $class;
}

=item $record-Eblock

=item $record-Eblock( $new_value )

Get or set the block contents of an in-memory record.  This method returns
undef if called on a WARC record from a volume and croaks if setting the
contents is attempted on a record from a volume.

=cut

sub block {
  my $self = shift;
  my $block = $self->{block};

  if (@_) {
    my $new = shift;

    if (ref $new) {
      if ($new->can('as_block'))
	{ $self->{block} = $new->as_block }
      elsif ($new->isa('HTTP::Message'))
	{ $self->{block} = $new->as_string(WARC::CRLF()) }
      elsif ($new->can('as_string'))
	{ $self->{block} = $new->as_string }
      else
	{ croak "unrecognized object submitted as WARC record block" }
    } else { $self->{block} = $new }

    use bytes;
    $self->{fields}->field('Content-Length', length $self->{block});
  }

  return $block;
}

=back

=cut

1;
__END__