1# Copyright (c) 2010-2013 Zmanda, Inc. All Rights Reserved. 2# 3# This program is free software; you can redistribute it and/or 4# modify it under the terms of the GNU General Public License 5# as published by the Free Software Foundation; either version 2 6# of the License, or (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, but 9# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 10# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 11# for more details. 12# 13# You should have received a copy of the GNU General Public License along 14# with this program; if not, write to the Free Software Foundation, Inc., 15# 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 16# 17# Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300 18# Sunnyvale, CA 94085, USA, or: http://www.zmanda.com 19 20 21=head1 NAME 22 23Amanda::Curinfo::Info - Perl extension for representing dump 24information 25 26=head1 SYNOPSIS 27 28 use Amanda::Curinfo::Info; 29 30 my $info = Amanda::Curinfo::Info->new($infofile); 31 32=head1 DESCRIPTION 33 34C<Amanda::Curinfo::Info> is the format representation for the curinfo 35database. It handles the reading and writing of the individual 36entries, while the entry management is left to C<Amanda::Curinfo>. 37Further parsing is also dispatched to C<Amanda::Curinfo::History>, 38C<Amanda::Curinfo::Stats>, and C<Amanda::Curinfo::Perf>. 39 40=head1 INTERFACE 41 42The constructor for a new info object is very simple. 43 44 my $info = Amanda::Curinfo::Info->new(); 45 46Will return an empty info object with the necessary fields all blank. 47 48Given an existing C<$info> object, for example, as provided by 49C<Amanda::Curinfo::get_info>, there are other functions present in this 50library, but they are helper functions to the previously described 51methods, and not to be used directly. 52 53It should also be noted that the reading and writing methods of 54C<Amanda::Curinfo::Info> are not meant to be used directly, and should be 55left to L<Amanda::Curinfo>. 56 57Reading a previously stored info object is handled with the same 58subroutine. 59 60 my $info = Amanda::Curinfo::Info->new($infofile); 61 62Here, C<$info> will contain all the information that was stored in 63C<$infofile>. 64 65To write the file to a new location, use the following command: 66 67 $info->write_to_file($infofile); 68 69There are also three corresponding container classes that hold data 70and perform parsing functions. They should only be used when actually 71writing info file data. 72 73 my $history = 74 Amanda::Curinfo::History->new( $level, $size, $csize, $date, $secs ); 75 my $stats = 76 Amanda::Curinfo::Stats->new( $level, $size, $csize, $secs, $date, $filenum, 77 $label ); 78 79 my $perf = Amanda::Curinfo::Perf->new(); 80 $perf->set_rate( $pct1, $pct2, $pct3 ); 81 $perf->set_comp( $dbl1, $dbl2, $dbl3 ); 82 83Note that C<Amanda::Curinfo::Perf> is different. This is because its 84structure is broken up into two lines in the infofile format, and the 85length of the C<rate> and C<comp> arrays maybe subject to change in 86the future. 87 88You can also instantiate these objects directly from a 89properly-formatted line in an infofile: 90 91 my $history = Amanda::Curinfo::History->from_line($hist_line); 92 my $stats = Amanda::Curinfo::Stats->from_line($stat_line); 93 94 my $perf = Amanda::Curinfo::Perf->new(); 95 $perf->set_rate_from_line($rate_line); 96 $perf->set_comp_from_line($comp_line); 97 98Again, creating C<Amanda::Curinfo::Perf> is broken into two calls 99because its object appears on two lines. 100 101Writing these objects back to the info file, however, are all identical: 102 103 print $infofh $history->to_line(); 104 print $infofh $stats->to_line(); 105 print $infofh $perf_full->to_line("full"); 106 print $infofh $perf_incr->to_line("incr"); 107 108Additionally, the C<$perf> object accepts a prefix to the line. 109 110=head1 SEE ALSO 111 112This package is meant to replace the file reading and writing portions 113of server-src/infofile.h. If you notice any bugs or compatibility 114issues, please report them. 115 116=head1 AUTHOR 117 118Paul C. Mantz E<lt>pcmantz@zmanda.comE<gt> 119 120=cut 121 122my $numdot = qr{[.\d]}; 123 124package Amanda::Curinfo::Info; 125 126use strict; 127use warnings; 128use Carp; 129 130use Amanda::Config; 131 132sub new 133{ 134 my ($class, $infofile) = @_; 135 136 my $self = { 137 command => undef, 138 full => Amanda::Curinfo::Perf->new(), 139 incr => Amanda::Curinfo::Perf->new(), 140 inf => [], # contains Amanda::Curinfo::Stats 141 history => [], # contains Amanda::Curinfo::History 142 last_level => undef, 143 consecutive_runs => undef, 144 }; 145 146 bless $self, $class; 147 $self->read_infofile($infofile) if -e $infofile; 148 149 return $self; 150} 151 152sub get_dumpdate 153{ 154 my ( $self, $level ) = @_; 155 my $inf = $self->{inf}; 156 my $date = 0; # Ideally should be set to the epoch, but 0 is fine 157 158 for ( my $l = 0 ; $l < $level ; $l++ ) { 159 160 my $this_date = $inf->[$l]->{date}; 161 $date = $this_date if ( $this_date > $date ); 162 } 163 164 my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = 165 gmtime $date; 166 167 my $dumpdate = sprintf( 168 '%d:%d:%d:%d:%d:%d', 169 $year + 1900, 170 $mon + 1, $mday, $hour, $min, $sec 171 ); 172 173 return $dumpdate; 174} 175 176sub read_infofile 177{ 178 my ( $self, $infofile ) = @_; 179 180 open my $fh, "<", $infofile or croak "couldn't open $infofile: $!"; 181 182 ## read in the fixed-length data 183 $self->read_infofile_perfs($fh); 184 185 ## read in the stats data 186 $self->read_infofile_stats($fh); 187 188 ## read in the history data 189 $self->read_infofile_history($fh); 190 191 close $fh; 192 193 return 1; 194} 195 196sub read_infofile_perfs 197{ 198 my ($self, $fh) = @_; 199 200 my $fail = sub { 201 my ($line) = @_; 202 croak "error: malformed infofile header in $self->infofile:$line\n"; 203 }; 204 205 my $skip_blanks = sub { 206 my $line = ""; 207 while ($line eq "") { 208 croak "error: infofile ended prematurely" if eof($fh); 209 $line = <$fh>; 210 } 211 return $line; 212 }; 213 214 # version not paid attention to right now 215 my $line = $skip_blanks->(); 216 ($line =~ /^version: ($numdot+)/) ? 1 : $fail->($line); 217 218 $line = $skip_blanks->(); 219 ($line =~ /^command: ($numdot+)/) ? $self->{command} = $1 : $fail->($line); 220 221 $line = $skip_blanks->(); 222 ($line =~ /^full-rate: ($numdot+) ($numdot+) ($numdot+)/) 223 ? $self->{full}->set_rate($1, $2, $3) 224 : $fail->($line); 225 226 $line = $skip_blanks->(); 227 ($line =~ /^full-comp: ($numdot+) ($numdot+) ($numdot+)/) 228 ? $self->{full}->set_comp($1, $2, $3) 229 : $fail->($line); 230 231 $line = $skip_blanks->(); 232 ($line =~ /^incr-rate: ($numdot+) ($numdot+) ($numdot+)/) 233 ? $self->{incr}->set_rate($1, $2, $3) 234 : $fail->($line); 235 236 $line = $skip_blanks->(); 237 ($line =~ /^incr-comp: ($numdot+) ($numdot+) ($numdot+)/) 238 ? $self->{incr}->set_comp($1, $2, $3) 239 : $fail->($line); 240 241 return 1; 242} 243 244sub read_infofile_stats 245{ 246 my ( $self, $fh ) = @_; 247 248 my $inf = $self->{inf}; 249 250 while ( my $line = <$fh> ) { 251 252 ## try next line if blank 253 if ( $line eq "" ) { 254 next; 255 256 } elsif ( $line =~ m{^//} ) { 257 croak "unexpected end of data in stats section (received //)\n"; 258 259 } elsif ( $line =~ m{^history:} ) { 260 croak "history line before end of stats section\n"; 261 262 } elsif ( $line =~ m{^stats:} ) { 263 264 ## make a new Stats object and push it on to the queue 265 my $stats = Amanda::Curinfo::Stats->from_line($line); 266 push @$inf, $stats; 267 268 } elsif ( $line =~ m{^last_level: (\d+) (\d+)$} ) { 269 270 $self->{last_level} = $1; 271 $self->{consecutive_runs} = $2; 272 last; 273 274 } else { 275 croak "bad line in read_infofile_stats: $line"; 276 } 277 } 278 279 return 1; 280} 281 282sub read_infofile_history 283{ 284 my ( $self, $fh ) = @_; 285 286 my $history = $self->{history}; 287 288 while ( my $line = <$fh> ) { 289 290 if ( $line =~ m{^//} ) { 291 return; 292 293 } elsif ( $line =~ m{^history:} ) { 294 my $hist = Amanda::Curinfo::History->from_line($line); 295 push @$history, $hist; 296 297 } else { 298 croak "bad line found in history section:$line\n"; 299 } 300 } 301 302 # 303 # TODO: make sure there were the right number of history lines 304 # 305 306 return 1; 307} 308 309sub write_to_file 310{ 311 my ( $self, $infofile ) = @_; 312 313 unlink $infofile if -f $infofile; 314 315 open my $fh, ">", $infofile or die "error: couldn't open $infofile: $!"; 316 317 ## print basics 318 319 print $fh "version: 0\n"; # 0 for now, may change in future 320 print $fh "command: $self->{command}\n"; 321 print $fh $self->{full}->to_line("full"); 322 print $fh $self->{incr}->to_line("incr"); 323 324 ## print stats 325 326 foreach my $stat ( @{ $self->{inf} } ) { 327 print $fh $stat->to_line(); 328 } 329 print $fh "last_level: $self->{last_level} $self->{consecutive_runs}\n"; 330 331 foreach my $hist ( @{ $self->{history} } ) { 332 print $fh $hist->to_line(); 333 } 334 print $fh "//\n"; 335 336 return 1; 337} 338 3391; 340 341# 342# 343# 344 345package Amanda::Curinfo::History; 346 347use strict; 348use warnings; 349use Carp; 350 351sub new 352{ 353 my $class = shift; 354 my ( $level, $size, $csize, $date, $secs ) = @_; 355 356 my $self = { 357 level => $level, 358 size => $size, 359 csize => $csize, 360 date => $date, 361 secs => $secs, 362 }; 363 364 return bless $self, $class; 365} 366 367sub from_line 368{ 369 my ( $class, $line ) = @_; 370 371 my $self = undef; 372 373 if ( 374 $line =~ m{^history: \s+ 375 (\d+) \s+ # level 376 ($numdot+) \s+ # size 377 ($numdot+) \s+ # csize 378 ($numdot+) \s+ # date 379 ($numdot+) $ # secs 380 }x 381 ) { 382 $self = { 383 level => $1, 384 size => $2, 385 csize => $3, 386 date => $4, 387 secs => $5, 388 }; 389 } else { 390 croak "bad history line: $line"; 391 } 392 393 return bless $self, $class; 394} 395 396sub to_line 397{ 398 my ($self) = @_; 399 return 400"history: $self->{level} $self->{size} $self->{csize} $self->{date} $self->{secs}\n"; 401} 402 4031; 404 405# 406# 407# 408 409package Amanda::Curinfo::Perf; 410 411use strict; 412use warnings; 413use Carp; 414 415use Amanda::Config; 416 417sub new 418{ 419 my ($class) = @_; 420 421 my $self = { 422 rate => undef, 423 comp => undef, 424 }; 425 426 return bless $self, $class; 427} 428 429sub set_rate 430{ 431 my ( $self, @rate ) = @_; 432 $self->{rate} = \@rate; 433} 434 435sub set_comp 436{ 437 my ( $self, @comp ) = @_; 438 $self->{comp} = \@comp; 439} 440 441sub set_rate_from_line 442{ 443 my ( $self, $line ) = @_; 444 return $self->set_field_from_line( $self, $line, "rate" ); 445 446} 447 448sub set_comp_from_line 449{ 450 my ( $self, $line ) = @_; 451 return $self->set_field_from_line( $self, $line, "comp" ); 452 453} 454 455sub set_field_from_line 456{ 457 my ( $self, $line, $field ) = @_; 458 459 if ( 460 $line =~ m{\w+-$field\: \s+ 461 ($numdot) \s+ 462 ($numdot) \s+ 463 ($numdot) $ 464 }x 465 ) { 466 $self->{$field} = [ $1, $2, $3 ]; 467 468 } else { 469 croak "bad perf $field line: $line"; 470 } 471 472 return; 473} 474 475sub to_line 476{ 477 my ( $self, $lvl ) = @_; 478 return 479 "$lvl-rate: " 480 . join( " ", @{ $self->{rate} } ) . "\n" 481 . "$lvl-comp: " 482 . join( " ", @{ $self->{comp} } ) . "\n"; 483} 484 4851; 486 487# 488# 489# 490 491package Amanda::Curinfo::Stats; 492 493use strict; 494use warnings; 495use Carp; 496 497sub new 498{ 499 my $class = shift; 500 my ( $level, $size, $csize, $secs, $date, $filenum, $label ) = @_; 501 502 my $self = { 503 level => $level, 504 size => $size, 505 csize => $csize, 506 secs => $secs, 507 date => $date, 508 filenum => $filenum, 509 label => $label, 510 }; 511 512 bless $self, $class; 513 return $self; 514} 515 516sub from_line 517{ 518 my ( $class, $line ) = @_; 519 my $self = undef; 520 521 $line =~ m{^stats: \s+ 522 (\d+) \s+ # level 523 ($numdot+) \s+ # size 524 ($numdot+) \s+ # csize 525 ($numdot+) \s+ # sec 526 ($numdot+) \s+ # date 527 ($numdot+) \s+ # filenum 528 (.*) $ # label 529 }x 530 or croak "bad stats line: $line"; 531 532 $self = { 533 level => $1, 534 size => $2, 535 csize => $3, 536 secs => $4, 537 date => $5, 538 filenum => $6, 539 label => $7, 540 }; 541 return bless $self, $class; 542} 543 544sub to_line 545{ 546 my ($self) = @_; 547 return join( " ", 548 "stats:", $self->{level}, $self->{size}, $self->{csize}, 549 $self->{secs}, $self->{date}, $self->{filenum}, $self->{label} ) 550 . "\n"; 551} 552 5531; 554