File Coverage

blib/lib/Astro/Hipparcos.pm
Criterion Covered Total %
statement 42 54 77.7
branch 10 24 41.6
condition 0 3 0.0
subroutine 8 9 88.8
pod 3 3 100.0
total 63 93 67.7


line stmt bran cond sub pod time code
1             package Astro::Hipparcos;
2              
3 1     1   24422 use 5.008;
  1         3  
  1         76  
4 1     1   4 use strict;
  1         2  
  1         27  
5 1     1   4 use warnings;
  1         5  
  1         32  
6 1     1   14 use Carp 'croak';
  1         2  
  1         61  
7 1     1   6 use File::Spec;
  1         1  
  1         46  
8              
9             our $VERSION = '0.09';
10              
11 1     1   5 use constant LINE_LENGTH => 451; # I wish they were using a modern file format.
  1         1  
  1         556  
12              
13             require XSLoader;
14             XSLoader::load('Astro::Hipparcos', $VERSION);
15              
16             sub new {
17 1     1 1 405 my $class = shift;
18 1         2 my $file = shift;
19 1 50       3 croak("Need catalog file") if not defined $file;
20 1 50       14 if (not -e $file) {
21 0 0       0 open my $fh, '>', $file or die "Could not open file '$file' for writing: $!";
22 0         0 close $fh;
23             }
24 1 50       34 open my $fh, '+<', $file or die "Could not open file '$file' for reading/writing: $!";
25 1         45 my $self = bless {
26             fh => $fh,
27             filename => $file,
28             filesize => (-s $file),
29             abs_file => File::Spec->rel2abs($file),
30             } => $class;
31 1         3 return $self;
32             }
33              
34             sub get_record {
35 9     9 1 7087 my $self = shift;
36 9         10 my $recno = shift;
37 9         10 my $line;
38 9         23 local $/ = "\012"; # database uses unix newlines
39 9         15 my $fh = $self->{fh};
40 9 100       19 if (not $recno) {
41 5         34 $line = <$fh>;
42 5 100       26 return if not defined $line;
43             }
44             else {
45 4         7 my $line_start = LINE_LENGTH*($recno-1);
46 4         5 my $line_end = $line_start+LINE_LENGTH;
47 4 50       11 return() if $line_end > $self->{filesize};
48 4 50       29 seek $fh, $line_start, 0
49             or die "Could not seek to pos '$line_start' of file '$self->{filename}': $!";
50 4         29 $line = <$fh>;
51 4 50       10 return if not defined $line;
52             }
53 6         26 my $record = Astro::Hipparcos::Record->new();
54 6         165 $record->ParseRecord($line);
55 6         23 return $record;
56             }
57              
58             sub append_record {
59 0     0 1   my $self = shift;
60 0           my $record = shift;
61 0 0 0       croak("Need Astro::Hipparcos::Record as first argument to append_record")
62             unless ref($record) and $record->isa("Astro::Hipparcos::Record");
63              
64 0           my $fh = $self->{fh};
65 0           my $orig_pos = tell($fh);
66 0 0         seek $fh, 0, 2 or die "Could not seek to end of file: $!";
67 0           print $fh $record->get_line();
68 0           $self->{filesize} = (-s $self->{abs_file});
69 0 0         seek $fh, $orig_pos, 0 or die "Could not seek to previous position: $!";
70 0           return 1;
71             }
72              
73             1;
74             __END__