package Net::Paraget::Interval; # # $Id: Interval.pm,v 1.6 2001/04/28 07:50:42 ftobin Exp $ # use strict; use Carp; use Class::MethodMaker get_set => [ qw( start end prev next assignment ) ], boolean => [ qw( completed ) ], copy => 'copy', new_hash_init => [ qw( new hash_init ) ]; sub flexible { my ( $self ) = @_; return not ( $self->assignment() or ( $self->completed() and $self->size() != 0 ) ); } sub info { my ( $self ) = @_; my $start = $self->start(); my $end = $self->end(); my $size = $end-$start; my $assigned = $self->assignment() ? 'yes' : 'no'; my $flexible = $self->flexible() ? 'yes' : 'no'; return "from $start to $end, size $size, assigned $assigned, flexible $flexible"; } sub is_empty { my ( $self ) = @_; return $self->end() <= $self->start(); } sub size { my ( $self ) = @_; my $size = $self->end() - $self->start(); if ($size < 0) { die $self->info(), " is wrong: an interval has a negative size"; } return $size; } # Split $self into three intervals: # start - offset, offset - offset, offset - end # The middle one is intended to be assigned # $self must not be assigned sub split { my ( $self, $offset ) = @_; die "Splitting assigned interval" if $self->assignment(); die "Splitting interval after end" if $self->end() < $offset; my $end = $self->end(); my $i1 = Net::Paraget::Interval->new( start => $offset, end => $offset); my $i2 = Net::Paraget::Interval->new( start => $offset, end => $end); my $start = $self->start; $self->state( "splitting $start at $offset", 1 ); $self->end($offset); # Insert into interval list my $orig_next = $self->next; $self->next($i1); $i1->next($i2); $i2->next($orig_next); $orig_next->prev($i2) if $orig_next; $i2->prev($i1); $i1->prev($self); die "self is negative" if $self->size() < 0; die "i1 is negative" if $i1->size() < 0; die "i2 is negative" if $i2->size() < 0; die "self end not at i1 start" if $self->end() != $i1->start(); die "i1 end not at i2 start" if $i1->end() != $i2->start(); die "i2 end not at orig_next start" if $orig_next and $i2->end() != $orig_next->start(); # Check if the first interval is empty, if so, remove it if ($self->start == $self->end) { $i1->remove(); return $self; } else { return $i1; } } # Extends one interval `self' to a new ending point `new_end'. # Any blocks after `self' that end before `new_end' gets removed. # Flexible blocks after `self' that start before `new_end' will have # their start moved to new_end. sub extend { my ( $self, $new_end ) = @_; die "Too many args to extend" if @_ > 2; die "Resizing unassigned interval" if not $self->assignment(); die "Resizing negatively" if $new_end < $self->end(); while ($self->next() and $self->next()->end() <= $new_end) { if ($self->start() > $self->next()->start()) { my $self_start = $self->start(); my $next_start = $self->next()->start(); die "Misordered interval list: $self_start > $next_start"; } $self->next()->remove(); } $self->state( "resizing to $new_end -- speed = " . ( $self->assignment->client->speed || 0), 2); if ($self->next and not $self->next()->flexible()) { $new_end = $self->next()->start(); } $self->end( $new_end ); $self->next()->start( $new_end ) if $self->next(); # if ( defined $new_start and $new_start != $self->start() # and $self->flexible() # ) # { # $self->resize( undef, $new_start ) if $new_start > $self->end(); # $self->start( $new_start ); # $self->prev->resize( undef, $new_start ) if $self->prev(); # } # if ( defined $new_end and $new_end != $self->end() ) # { # $self->resize( $new_end, undef ) if $new_end < $self->start(); # $self->end( $new_end ); # $self->next->resize( $new_end, undef ) if $self->next(); # } # $self->remove() if $self->size() < 0; } sub remove { my ( $self ) = @_; $self->prev->next( $self->next() ); # this must always happen, given the head $self->next->prev( $self->prev() ) if $self->next(); if ( $self->assignment() and $self->assignment->client() ) { $self->state( "removing self and stopping client", 1); $self->assignment->client->stop(); } $self->DESTROY(); } # Assumes that both intervals are flexible sub merge_ahead { my ( $self ) = @_; croak "Inflexible interval" if not ($self->flexible() and $self->next()->flexible); my $old_next = $self->next() or return; # don't worry if we're at the end of the list my $new_next = $old_next->next(); $self->hash_init( end => $old_next->end(), next => $new_next, ); $new_next->prev( $self ) if $new_next; $old_next->DESTROY(); } sub similar_to { my ( $self, $compare ) = @_; return not ( $self->assignment() xor $compare->assignment() ); } sub resize_from_report { my ( $self, $report ) = @_; my $start = $self->start(); my $amount = $report->amount_completed(); my $new_end = $start + $amount; $self->extend( $new_end ); } sub eta { my ( $self ) = @_; my $prev = $self->prev(); return undef if not $prev->assignment(); my $speed = $prev->assignment->server->a_speed(); return undef if $speed == 0; return $self->size / $speed; } sub extendable_to { my ( $self ) = @_; my $i = $self; my $point = $self->end(); while ( $i = $i->next() ) { last if not $i->flexible(); $point = $i->end(); } return $point; } sub DESTROY { my ( $self ) = @_; $self->clear_next(); $self->clear_prev(); } sub die { my ( $self, @errors ) = @_; CORE::die $self->info(), "\n", @errors; } sub state { my ( $self, $string, $priority ) = @_; main::state( "interval " . $self->info() . ": " . $string, $priority ); } 1;