git.gag.com Git - debian/amanda/blob - perl/Amanda/Report/xml.pm

   1 # Copyright (c) 2010 Zmanda, Inc.  All Rights Reserved.
   2 #
   3 # This program is free software; you can redistribute it and/or modify it
   4 # under the terms of the GNU General Public License version 2 as published
   5 # by the Free Software Foundation.
   6 #
   7 # This program is distributed in the hope that it will be useful, but
   8 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   9 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  10 # for more details.
  11 #
  12 # You should have received a copy of the GNU General Public License along
  13 # with this program; if not, write to the Free Software Foundation, Inc.,
  14 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  15 #
  16 # Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300
  17 # Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
  18
  19
  20 package Amanda::Report::xml;
  21
  22 use strict;
  23 use warnings;
  24
  25 use base qw/Exporter/;
  26
  27 use Amanda::Constants;
  28
  29 our @EXPORT_OK = qw/make_amreport_xml/;
  30
  31 my $indent = " " x 4;
  32 my $depth  = 0;
  33
  34 ## Public Interface
  35
  36 sub make_amreport_xml
  37 {
  38     my ( $report, $org, $config_name ) = @_;
  39     return make_xml_elt(
  40         "amreport",
  41         sub {
  42             return join(
  43                 "\n",
  44                 make_xml_elt( "org",    $org ),
  45                 make_xml_elt( "config", $config_name ),
  46                 make_xml_elt( "date",   time() ),
  47                 make_programs_xml( $report->{data}{programs} ),
  48                 map {
  49                     make_dle_xml( $_->[0], $_->[1],
  50                         $report->get_dle_info( $_->[0], $_->[1] ) )
  51                   } $report->get_dles()
  52             );
  53         },
  54         { version => $Amanda::Constants::VERSION }
  55     );
  56 }
  57
  58 ## xml printing functions
  59
  60 sub xml_nl
  61 {
  62     return "\n" . ( $indent x $depth );
  63 }
  64
  65 sub make_xml_elt
  66 {
  67     my ( $tag, $val, $attribs ) = @_;
  68     my $text;
  69
  70     $indent += 1;
  71     $text = "<$tag";
  72
  73     if ( defined $attribs ) {
  74         $text .= ' '
  75           . join(
  76             ' ', map { $_ . '="' . $attribs->{$_} . '"' }
  77               keys %$attribs
  78           );
  79     }
  80
  81     if ( ref $val eq "CODE" ) {
  82         $text .= ">" . xml_nl() . $val->() . xml_nl() . "</$tag>";
  83     } else {
  84         $text .= ( defined $val ) ? ">$val</$tag>" : " />";
  85     }
  86
  87     $indent -= 1;
  88     return $text;
  89 }
  90
  91 sub make_list_xml
  92 {
  93     my ( $list, $item, @items ) = @_;
  94     return make_xml_elt(
  95         $list,
  96         sub {
  97             return join( xml_nl(), map { make_xml_elt( $item, $_ ); } @items );
  98         }
  99     );
 100 }
 101
 102 ## Amanda::Report data elements
 103
 104 sub make_dumper_xml
 105 {
 106     my ($dumper) = @_;
 107     return make_xml_elt(
 108         "dumper",
 109         sub {
 110             return join(
 111                 xml_nl(),
 112                 make_xml_elt("insize",  $dumper->{orig_kb} * 1024),
 113                 make_xml_elt("outsize", $dumper->{kb} * 1024),
 114                 make_xml_elt("time",    $dumper->{sec})
 115             );
 116         },
 117         { "result" => $dumper->{status} }
 118     );
 119 }
 120
 121 sub make_chunker_xml
 122 {
 123     my ($chunker) = @_;
 124     return make_xml_elt(
 125         "chunker",
 126         sub {
 127             return join(
 128                 xml_nl(),
 129                 make_xml_elt( "date",  $chunker->{date} ),
 130                 make_xml_elt( "level", $chunker->{level} ),
 131                 make_xml_elt( "time",  $chunker->{sec} ),
 132                 make_xml_elt( "bytes", $chunker->{kb} * 1024 ),
 133                 make_xml_elt( "bps",   $chunker->{kps} * 1024 ),
 134             );
 135         },
 136         { "result" => $chunker->{status} }
 137     );
 138 }
 139
 140 sub make_taper_xml
 141 {
 142     my ($taper) = @_;
 143     return make_xml_elt(
 144         "taper",
 145         sub {
 146             return join(
 147                 xml_nl(),
 148                 make_xml_elt( "date",  $taper->{date} ),
 149                 make_xml_elt( "level", $taper->{level} ),
 150                 make_xml_elt( "time",  $taper->{sec} ),
 151                 make_xml_elt( "bytes", $taper->{kb} * 1024 ),
 152                 make_xml_elt( "bps",   $taper->{kps} * 1024 ),
 153                 map { make_part_xml($_) } @{ $taper->{parts} }
 154             );
 155         },
 156         { result => $taper->{status} }
 157     );
 158 }
 159
 160 sub make_try_xml
 161 {
 162     my ($try) = @_;
 163     return make_xml_elt(
 164         "try",
 165         sub {
 166             return join xml_nl(), map {
 167                     ($_ eq "dumper")  ? make_dumper_xml($try->{$_})
 168                   : ($_ eq "chunker") ? make_chunker_xml($try->{$_})
 169                   : ($_ eq "taper")   ? make_taper_xml($try->{$_})
 170                   :                   "";
 171             } keys %$try;
 172         }
 173     );
 174 }
 175
 176 sub make_estimate_xml
 177 {
 178     my ($estimate) = @_;
 179     return (defined $estimate)
 180       ? make_xml_elt(
 181         "estimate",
 182         sub {
 183             return join(
 184                 xml_nl(),
 185                 make_xml_elt("level",  $estimate->{level}),
 186                 make_xml_elt("time",   $estimate->{sec}),
 187                 make_xml_elt("nbytes", $estimate->{nkb} * 1024),
 188                 make_xml_elt("cbytes", $estimate->{ckb} * 1024),
 189                 make_xml_elt("bps",    $estimate->{kps} * 1024)
 190             );
 191         }
 192       )
 193       : "";
 194 }
 195
 196 sub make_part_xml
 197 {
 198     my ($part) = @_;
 199     return make_xml_elt(
 200         "part",
 201         sub {
 202             return join( xml_nl(),
 203                 make_xml_elt( "label", $part->{label} ),
 204                 make_xml_elt( "date",  $part->{date} ),
 205                 make_xml_elt( "file",  $part->{file} ),
 206                 make_xml_elt( "time",  $part->{sec} ),
 207                 make_xml_elt( "bytes", $part->{kb} * 1024 ),
 208                 make_xml_elt( "bps",   $part->{kps} * 1024 ),
 209                 make_xml_elt( "partnum", $part->{partnum} )
 210             );
 211         }
 212     );
 213 }
 214
 215 sub make_dump_xml
 216 {
 217     my ($dle, $timestamp) = @_;
 218
 219     return make_xml_elt(
 220         "dump",
 221         sub {
 222             return join( xml_nl(),
 223                 make_xml_elt("date", $timestamp),
 224                 map { make_try_xml($_) } @{$dle->{'dumps'}->{$timestamp}});
 225         }
 226     );
 227 }
 228
 229 sub make_dle_xml
 230 {
 231     my ( $hostname, $disk, $dle ) = @_;
 232     return make_xml_elt(
 233         "dle",
 234         sub {
 235             return join( xml_nl(),
 236                 make_xml_elt( "hostname", $hostname ),
 237                 make_xml_elt( "disk",     $disk ),
 238                 ( defined $dle->{estimate} && %{ $dle->{estimate} } > 0 )?
 239                       make_estimate_xml( $dle->{estimate} )
 240                     : (),
 241                 ( keys %{$dle->{'dumps'}} > 0 ) ?
 242                       map { make_dump_xml($dle, $_) } keys %{$dle->{'dumps'}}
 243                     : (),
 244                 exists $dle->{parts} ?
 245                       map { make_part_xml($_) } @{ $dle->{parts} }
 246                     : ()
 247             );
 248         }
 249     );
 250 }
 251
 252 sub make_program_xml
 253 {
 254     my ( $program_name, $program, $content ) = @_;
 255     return make_xml_elt(
 256         $program_name,
 257         sub {
 258             return join(
 259                 xml_nl(),
 260                 $content->(),
 261                 ( exists $program->{notes} )
 262                 ? make_list_xml( "notes", "note", @{ $program->{notes} } )
 263                 : (),
 264                 ( exists $program->{stranges} )
 265                 ? make_list_xml( "stranges", "strange",
 266                     @{ $program->{stranges} } )
 267                 : (),
 268                 ( exists $program->{errors} )
 269                 ? make_list_xml( "errors", "error", @{ $program->{errors} } )
 270                 : (),
 271             );
 272         }
 273     );
 274 }
 275
 276 sub make_planner_xml
 277 {
 278     my ($planner) = @_;
 279     return make_program_xml(
 280         "planner", $planner,
 281         sub {
 282             return join( xml_nl(),
 283                 make_xml_elt( "time",       $planner->{time} ),
 284                 make_xml_elt( "start",      $planner->{start} ),
 285                 make_xml_elt( "start_time", $planner->{start_time} ) );
 286         }
 287     );
 288 }
 289
 290 sub make_driver_xml
 291 {
 292     my ($driver) = @_;
 293     return make_program_xml(
 294         "driver", $driver,
 295         sub {
 296             return join( xml_nl(),
 297                 make_xml_elt( "time",  $driver->{time} ),
 298                 make_xml_elt( "start", $driver->{start} ) );
 299         }
 300     );
 301 }
 302
 303 sub make_dumper_program_xml
 304 {
 305     my ($dumper) = @_;
 306     return make_program_xml( "dumper", $dumper, sub { return ""; } );
 307 }
 308
 309 sub make_chunker_program_xml
 310 {
 311     my ($chunker) = @_;
 312     return make_program_xml( "chunker", $chunker, sub { return ""; } );
 313 }
 314
 315 sub make_tape_xml
 316 {
 317     my ( $tape_name, $tape ) = @_;
 318     return make_xml_elt(
 319         "tape",
 320         sub {
 321             return join(
 322                 xml_nl(),
 323                 make_xml_elt( "name", $tape_name ),
 324                 make_xml_elt( "date", $tape->{date} ),
 325                 defined $tape->{files}
 326                 ? make_xml_elt( "files", $tape->{files} )
 327                 : (),
 328                 defined $tape->{kb}
 329                 ? make_xml_elt( "bytes", $tape->{kb} * 1024 )
 330                 : ()
 331             );
 332         }
 333     );
 334 }
 335
 336 sub make_tapelist_xml
 337 {
 338     my ($tapelist) = @_;
 339     return make_xml_elt(
 340         "tapelist",
 341         sub {
 342             return join(
 343                 xml_nl(),
 344                 map { make_tape_xml( $_, $tapelist->{$_} ) } keys %$tapelist
 345             );
 346         }
 347     );
 348 }
 349
 350 sub make_taper_program_xml
 351 {
 352     my ($taper) = @_;
 353     return make_program_xml(
 354         "taper", $taper,
 355         sub {
 356             return
 357               defined $taper->{tapes}
 358               ? make_tapelist_xml( $taper->{tapes} )
 359               : ();
 360         }
 361     );
 362 }
 363
 364 #
 365 # Note: make_program_xml is a super-type for the individual programs,
 366 # make_programs_xml is the element container for the programs
 367 #
 368 sub make_programs_xml
 369 {
 370     my ($programs) = @_;
 371
 372     return make_xml_elt(
 373         "programs",
 374         sub {
 375             return join( xml_nl(),
 376                 exists $programs->{planner}
 377                 ? make_planner_xml( $programs->{planner} )
 378                 : (),
 379                 exists $programs->{driver}
 380                 ? make_driver_xml( $programs->{driver} )
 381                 : (),
 382                 exists $programs->{dumper}
 383                 ? make_dumper_program_xml( $programs->{dumper} )
 384                 : (),
 385                 exists $programs->{chunker}
 386                 ? make_chunker_program_xml( $programs->{chunker} )
 387                 : (),
 388                 exists $programs->{taper}
 389                 ? make_taper_program_xml( $programs->{taper} )
 390                 : () );
 391         }
 392     );
 393 }
 394
 395 1;
 396 __END__
 397
 398 =head1 NAME
 399
 400 Amanda::Report::xml - output Amanda::Report objects in xml format
 401
 402 =head1 SYNOPSIS
 403
 404    use Amanda::Report;
 405    my $report = Amanda::Report->new($logfile);
 406    print $report->output_xml();
 407
 408 =head1 DESCRIPTION
 409
 410 Stub documentation for Amanda::Report::xml,
 411
 412 Blah blah blah.
 413
 414 =head2 EXPORT
 415
 416 None by default.
 417
 418 =head1 SEE ALSO
 419
 420 Mention other useful documentation such as the documentation of
 421 related modules or operating system documentation (such as man pages
 422 in UNIX), or any relevant external documentation such as RFCs or
 423 standards.
 424
 425 If you have a mailing list set up for your module, mention it here.
 426
 427 If you have a web site set up for your module, mention it here.
 428
 429 =head1 AUTHOR
 430
 431 Paul C Mantz, E<lt>pcmantz@zmanda.comE<gt>
 432
 433 =head1 BUGS
 434
 435 None reported... yet.
 436
 437 =cut