view release on metacpan or  search on metacpan

lib/LCC.pm  view on Meta::CPAN

#  Create local copy of Documents object for this iteration

  my $first = $self->{'_next_documents'} || 0;
  my $next = $self->{'_next_documents'} = @{$documents};
  for (my $i = $first; $i < $next; $i++) {
    my $thistime = $documents->[$i];

#  Obtain the browse URL code reference
#  Obtain the conceptual URL code reference
#  Obtain the fetch URL code reference

    my $burl = $thistime->browse_url || $thistime->_browse_url;
    my $curl = $thistime->conceptual_url || $thistime->_conceptual_url;
    my $furl = $thistime->fetch_url || $thistime->_fetch_url;

#  While there are document to be fetched
#   Create the string for the list
#   Reloop if there was no change

    while (my ($id,@list) = $thistime->next_document) {
      my $list = join( "\0",@list );
      next if $list eq $old->{$id};

#   Add error if we did this one already and reloop
#   Add this document to the list to be done
#   Add URL information for this document ID

      $self->_add_error( "Document with ID '$id' was already added" ), next
       if exists( $new->{$id} );
      $new->{$id} = $list;
      $url->{$id} = {
       burl => $burl->( $id ),
       curl => $curl->( $id ),
       furl => $furl->( $id ),
      };
    }
  }

# Return indicating how many new documents there are now

  return keys %{$backend->{'new'}};
} #check

#-------------------------------------------------------------------------

#  IN: 1 instantiated LCC object

sub complete { shift->_backend_method( 'complete',@_ ) } #complete

#-------------------------------------------------------------------------

#  IN: 1 instantiated LCC object
#      2 (optional) flag to force partial document set

sub partial { shift->_backend_method( 'partial',@_ ) } #partial

#-------------------------------------------------------------------------

#  IN: 1 instantiated LCC object

sub update { shift->_backend_method( 'update',@_ ) } #update

#-------------------------------------------------------------------------

#  IN: 1 instantiated object
#      2 reference to hash with provider credentials (id and password)
#      3 handle to write XML to or reference to list of handles to write to
#        (default: just return the resulting XML)
# OUT: 1 resulting XML

sub update_notification_xml {

# Obtain the object
# Obtain the credentials
# Obtain the handles to write to
# Initialize the XML

  my $self = shift;
  my $credentials = shift;
  my @handle = ref($_[0]) eq 'ARRAY' ? @{(shift)} : shift;

# Create a local copy to the backend
# Create the type of set we're working with

  my $backend = $self->{'Backend'};
  my $set = keys %{$backend->{'old'}} ? 'partial' : 'complete';

# Start the XML
# Send it to the handles (if appropriate)
  
  my $xml = <<EOD;
<lococa:notify>
 <init>
  <provider id="$credentials->{'id'}" password="$credentials->{'password'}"/>
 </init>
 <set set="$set">
EOD
  print $_ $xml foreach @handle;

# Create local copy of list of new documents
# Create local copy of URL info of new documents
# While there are documents to be processed
#  Obtain the constituent parts
#  Initialize the line for this document

  my $new = $backend->{'new'} || {};
  my $url = $backend->{'url'} || {};
  while (my ($id,$value) = each %{$new}) {
    my ($mtime,$length,$md5,$mimetype,$subtype) = split( m#\0#,$value );
    my $line = "  <url";

#  If there is URL info (there should be, really)
#   Foreach of the special fields
#    Reloop if no specific info
#    Add field to this documents XML

    if (my $urlid = $url->{$id} || '') {
      foreach (qw(curl burl furl)) {
        next unless $urlid->{$_} || '';
        $line .= qq( $_="$urlid->{$_}");
      }
    }

#  Add the constituent parts if applicable

    $line .= qq( mtime="$mtime") if $mtime || '';
    $line .= qq( len="$length") if $length || '';
    $line .= qq( md5="$md5") if $md5 || '';
    $line .= qq( mimetype="$mimetype") if $mimetype || '';
    $line .= qq( subtype="$subtype") if $subtype || '';