File Coverage

blib/lib/SNA/Network/Filter/Pajek.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	11	16	68.7
condition	1	2	50.0
subroutine	8	8	100.0
pod	3	3	100.0
total	66	72	91.6

package SNA::Network::Filter::Pajek;

use warnings;
use strict;

require Exporter;
use base qw(Exporter);
our @EXPORT = qw(load_from_pajek_net new_from_pajek_net save_to_pajek_net);

use Carp;
use English;


=head1 NAME

SNA::Network::Filter::Pajek - load and save networks from/to Pajek .net files


=head1 SYNOPSIS

Quick summary of what the module does.

Perhaps a little code snippet.

    use SNA::Network;

    my $net = SNA::Network->new();
    $net->load_from_pajek_net($filename);
    ...
    # shortcut
    my $net = SNA::Network->new_from_pajek_net($filename);
    ...
    $net->save_to_pajek_net($filename);


=head1 DESCRIPTION

This enables import/export to the Pajek data format.
See L for details about the format.


=head1 METHODS

The following methods are added to L.

=head2 load_from_pajek_net

load a network from a passed filename.
Nodes and edges are created as specified in the file, with the vertex name in the I field of the created nodes.

=cut

sub load_from_pajek_net {
	my ($self, $filename) = @_;
	open my $PAJEK_FILE, '<', $filename or croak "cannot open '$filename': $OS_ERROR\n";

	my $line;

	# search start of vertex definitions
	START:
	while (defined($line = <$PAJEK_FILE>)) {
		last START if $line =~ m/\*Vertices/;
	}

	# read vertices and create graph nodes
	VERTICES:
	while (defined($line = <$PAJEK_FILE>)) {
		last VERTICES if $line =~ m/\*Arcs/;

		$line =~ m/\s*(\d+)\s*(.*)/ or next VERTICES;
		my ($node_number, $node_name) = ($1, $2);

		$self->create_node_at_index(index => $node_number - 1, name => $node_name);
	}

	# read arcs and create graph edges
	EDGES:
	while (defined($line = <$PAJEK_FILE>)) {
		last EDGES unless $line =~ m/\s*(\d+)\s*(\d+)\s*(\d+)/;
		my ($source_index, $target_index, $weight) = ($1 - 1, $2 - 1, $3);
		$self->create_edge(
			source_index => $source_index,
			target_index => $target_index,
			weight       => $weight,
		);
	}

	close $PAJEK_FILE or croak "cannot close '$filename': $OS_ERROR\n";
}



=head2 new_from_pajek_net

Returns a newly created network from a passed filename.
Nodes and edges are created as specified in the file, with the vertex name in the I field of the created nodes.

=cut

sub new_from_pajek_net {
	my ($package, $filename) = @_;
	my $net = $package->new;
	$net->load_from_pajek_net($filename);
	return $net;
}



=head2 save_to_pajek_net

=cut

sub save_to_pajek_net {
	my ($self, $filename) = @_;

	open my $PAJEK_FILE, '>', $filename or croak "cannot open '$filename': $OS_ERROR\n";

	# process vertices
	printf $PAJEK_FILE "*Vertices %d\n", int $self->nodes();
	foreach my $node ($self->nodes()) {
		printf $PAJEK_FILE "%d %s\n", $node->{index} + 1, $node->{name} || 'none';
	}

	printf $PAJEK_FILE "*Arcs\n";
	foreach my $arc ($self->edges()) {
		printf $PAJEK_FILE "%d %d %d\n",
			$arc->source()->index() + 1, $arc->target()->index() + 1, $arc->weight();
	}

	close $PAJEK_FILE or croak "cannot close '$filename': $OS_ERROR\n";
}


=head1 AUTHOR

Darko Obradovic, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc SNA::Network


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 COPYRIGHT & LICENSE

Copyright 2009 Darko Obradovic, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1; # End of SNA::Network::Filter::Pajek