callflowcanvas.pm

来自「radius协议源码÷The Radius Stack will connect」· PM 代码 · 共 1,127 行 · 第 1/3 页

	    }
	}

	#Finally, resize the page to include the new set of items, sans orphans.
	#(Don't mess with the x-coordinates; those must remain fixed to ensure
	#that the whole horizontal spread will be squeezed down to fit on one page.)
	($y1, $y2) = ($canvas->bbox (@filtered_items))[1,3];
	#Fudge the upper bound to include the first SIP message label.
	#Otherwise it will not quite fit (due to a quirk in the bbox method).
	$y1 -= 10 unless $self->{file_number} == 0; #Don't try it with the first snapshot!
    };

    #Cut the canvas down so there are no items (servers or messages)
    #hanging off its edges.
    my $_crop_canvas =
    sub
    {
	my ($self) = @_;
	my $canvas = $self->{canvas};

	#!my $x1 = \{$self->{x1}};
	#!my $x2 = \{$self->{x2}};
	#!my $y1 = \{$self->{y1}};
	#!my $y2 = \{$self->{y2}};

	print "Cropping from ($self->{x1}, $self->{y1}), ($self->{x2}, $self->{y2})...\n" if DEBUG_SNAPSHOTS == 2;
	my @items = $canvas->find ('enclosed', $self->{x1}, $self->{y1}, $self->{x2}, $self->{y2});
	unless (defined @items)
	{
	    print "Found no enclosed items!\n" if DEBUG_SNAPSHOTS;
	    return;
	}
    
        #Leave $x1 and $y1 intact no matter what.  They are guaranteed to be
	#justified just past the ending position of the last snapshot area
	#(or, in the case of the first snapshot, justified to the top of the page).
    
	#In the case of smart pagination, we know that the x range will include
	#the whole viewable area of the canvas, so we leave $x1 and $x2 alone too. 
        my $paginate_snapshots = $self->{paginate_snapshots};
	if ($paginate_snapshots eq 'smart')
	{
	    $self->{y2} = ($canvas->bbox (@items))[3];
	}
	#In the case of dumb pagination, the x range can vary.
	elsif ($paginate_snapshots eq 'dumb')
	{
	    my @bounding_coordinates = $canvas->bbox (@items);
	    $self->{x2} = $bounding_coordinates[2];
	    $self->{y2} = $bounding_coordinates[3];
	}
    
	print "         to   ($self->{x1}, $self->{y1}), ($self->{x2}, $self->{y2})\n\n" if DEBUG_SNAPSHOTS == 2;
	return \@items;
    };

#!#!#!}
#end of protected methods and class variables


#public methods

sub new
{
    my ($class, $parent, $canvas, $snapshot_preferences, $paginate_snapshots, $options, $sip_message) = @_;
    my %self;
    my $self = bless \%self, $class;
    $self{parent} = $parent;
    &$_set_initial_positions ($self);

    $self->{canvas} = $canvas;

    my %server_hash = (); $self->{server_hash} = \%server_hash;
    my @server_list = (); $self->{server_list} = \@server_list;
    my @sip_messages = []; $self->{sip_messages} = \@sip_messages;
    $self->add_sip_message ($sip_message) if ref $sip_message eq 'Telephony::SipMessage';

    if (defined $snapshot_preferences)
    {
	$self{snapshot_preferences} = $snapshot_preferences;
    }
    else
    {
	$self{snapshot_preferences} = \%default_snapshot_preferences;
    }
    $self{paginate_snapshots} = $paginate_snapshots;
    $self->{heuristic} = $options->{heuristic} if defined $options->{heuristic};
    $self->{logical_names} = $options->{logical_names} if defined $options->{logical_names};
    print "Created a new CallFlowCanvas:\n" . Data::Dumper->Dump ([ $self ]) if DEBUG;
    return $self;
}

sub _construct_canvas
{
    return $_[0]->Scrolled ('Canvas',
			    -scrollbars   => 'ose',
			    width         => $settings{canvas_width},
			    height        => $settings{canvas_height},
			    relief        => 'flat',
			    background    => $colors{canvas_background}
			    #foreground   => $colors{canvas_foreground}
			    #! font       => $settings{canvas_default_font}
			    );
}

sub hide
{
    my ($self) = @_;
    my $canvas = $self->{canvas};
    $canvas->delete ($canvas->find ('all'));
    &$_set_initial_positions ($self);
}

sub show
{
    my ($self) = @_;
    $self->restore_server_boxes();
    foreach my $message (@{$self->{sip_messages}})
    {
	&$_draw_arrow ($self, $message);# if ref $message eq 'Telephony::SipMessage';
    }
    &$_resize_canvas ($self);
}

sub add_sip_message
{
    my ($self, $message, $draw) = @_;
    my $this_canvas_call_id = $self->get_call_id();
    if (defined $this_canvas_call_id
	&& ($message->get_call_id() ne $this_canvas_call_id))
    {
	confess ('Got a SipMessage with the wrong call ID for this canvas!');
    }
    else #this canvas doesn't have a call ID defined yet.  Make one.
    {
	$self->{call_id} = $message->get_call_id();
    }
	
    &$_handle_new_servers ($self, $message, 'source', $draw);
    &$_handle_new_servers ($self, $message, 'destination', $draw);
    push @{$self->{sip_messages}}, $message;
    if ($draw)
    {
	&$_draw_arrow ($self, $message);
	&$_resize_canvas ($self);
    }
}

sub change_snapshot_preferences
{
    my ($self, $prefs) = @_;
    $self->{snapshot_preferences} = $prefs;
}

sub batch_mode
{
    if (@_)
    {
	($batch_process) = @_;
    }
    else
    {
	return $batch_process;
    }
}

sub get_call_id
{
    my ($self) = @_;
    return $self->{call_id};
}

#Make sure there is space for all the servers.
sub readjust_width
{
    my ($self) = @_;

    my $total_server_hspace =
    $self->{total_server_hspace} = @{$self->{server_list}}
                                   * ($settings{server_box_hsize}
				   + $settings{space_between_servers})
			           + $settings{server_start_hposition};
    if ($self->{canvas_width} < $total_server_hspace)
    {
	$self->{canvas_width} = $total_server_hspace;
    }
}

sub insert_break
{
    print "In CallFlowCanvas::insert_break...\n" if DEBUG;
    my ($self, $label) = @_;

    my $canvas = $self->{canvas};

    my ($leftmost_x, $rightmost_x) = ($canvas->bbox ('all'))[0, 2];
    print "Drawing line from $leftmost_x to $rightmost_x\n" if DEBUG;
    
    if (defined $label)
    {
	print "Drawing text \"$label\" at ($leftmost_x, " . $self->{arrow_vposition} + 2 . ")\n" if DEBUG;

	$canvas->createText ($leftmost_x,
			     $self->{arrow_vposition},
			     text    => $label,
			     font    => $settings{break_font},
			     #! width   => $settings{server_hsize},
			     fill    => $colors{break},
			     justify => 'right'
			     );
    }

    $self->{arrow_vposition} += $settings{break_offset_space};

    $canvas->createLine ($leftmost_x,
			 $self->{arrow_vposition},
			 $rightmost_x,
			 $self->{arrow_vposition},
			 width => $settings{break_width},
			 smooth => 1,
			 fill => $colors{break}
			 );
    &$_resize_canvas ($self);
    $self->{arrow_vposition} += $settings{break_width} = $settings{break_offset_space};
}

sub take_snapshot
{
    my ($self) = @_;
    my $canvas = $self->{canvas};

    #!my $x1 = \{; $self{x1}};
    #!my $y1 = \{; $self{y1}};
    #!my $x2 = \{; $self{x2}};
    #!my $y2 = \{; $self{y2}};

    $self->{output_filename} = $self->{snapshot_preferences}->{file} . $self->get_call_id();
    $self->{file_number} = 0;
    my ($least_x, $least_y, $greatest_x, $greatest_y) = $canvas->bbox ('all');
    if (DEBUG_SNAPSHOTS)
    {
	$canvas->createRectangle ($least_x, $least_y, $greatest_x, $greatest_y, outline => 'red');
    }

    print "Canvas dimensions are ($least_x, $least_y), ($greatest_x, $greatest_y)\n" if DEBUG_SNAPSHOTS;

    unless (defined $self->{paginate_snapshots}) #Just take one big snapshot.
    {
	#!@self->{'x1', 'y1', 'x2', 'y2'} = ($least_x, $least_y, $greatest_x, $greatest_y);
	$self->{x1} = $least_x;
	$self->{y1} = $least_y;
	$self->{x2} = $greatest_x;
	$self->{y2} = $greatest_y;

	&$_take_snapshot_page($self);
	return;
    }

    #Divide the canvas into pages of fixed width (configured through the
    #"Snapshot Properties" button).  If --paginate-snapshots was set to smart,
    #use additional formatting heuristics.

    if ($self->{paginate_snapshots} eq 'dumb')
    {
	$self->{x1} = $least_x;             #set here as well as in $self->_do_horizontal
	$self->{x2} = $self->{x1} + $page_width;    #so that $self->_crop_canvas will have all the
	                            #variables it needs to work the first
	                            #time it is invoked, before $self->_do_horizontal
	$self->{y1} = $least_y;
	$self->{y2} = $self->{y1} + $page_length;
	
	if ($self->{y2} >= $greatest_y)
	{
	    $self->{y2} = $greatest_y;
	    &$_do_horizontal ($self); #one last time...
	    return;
	}
	while (1)
	{
	    $self->_do_horizontal();
	}
	continue
	{
	    $self->{y1} = $self->{y2};
	    $self->{y2} += $page_length;
	    if ($self->{y2} >= $greatest_y)
	    {
		$self->{y2} = $greatest_y;
		&$_do_horizontal ($self);
		return;
	    }
	}
    }
    else # $paginate_snapshots eq 'smart', by deduction
    {
	$self->{x1} = $least_x;
	$self->{x2} = $greatest_x;
	$self->{y1} = $least_y;
	$self->{y2} = $self->{y1} + $page_length;
	if ($self->{y2} >= $greatest_y)
	{
	    &$_do_snapshot ($self); #one last time...
	    return;
	}
	while (1)
	{
	    &$_adjust_snapshot_boundaries ($self);
	    &$_do_snapshot ($self);
	}
	continue
	{
	    $self->{y1} = $self->{y2};
	    $self->{y2} += $page_length;
	    if ($self->{y2} >= $greatest_y)
	    {
		$self->{y2} = $greatest_y;
		&$_do_snapshot ($self);
		return;
	    }
	}
    }
}

sub last_sip_message
{
    my ($self) = @_;
    $self->take_snapshot() if $self->{batch_process};
}

#Erase servers and their window dressing from the canvas.
sub remove_server_boxes
{
    my ($self) = @_;
    my $canvas = $self->{canvas};
    $canvas->delete ($canvas->find ('withtag', 'server_box'));
    $canvas->delete ($canvas->find ('withtag', 'vertical_line'));
    $canvas->delete ($canvas->find ('withtag', 'server_label'));

}

#Restore servers and their window dressing to the canvas.
sub restore_server_boxes
{
    local $_;
    my ($self) = @_;
    map { &$_draw_server_box ($self, $_); } @{$self->{server_list}};    
}

=head1 NAME

CallFlowCanvas - Perl extension for blah blah blah

=head1 SYNOPSIS

  use CallFlowCanvas;
  blah blah blah

=head1 DESCRIPTION

Stub documentation for CallFlowCanvas was created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.

Blah blah blah.

=head1 AUTHOR

A. U. Thor, [e-mail]

=head1 SEE ALSO

perl(1).

=cut