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

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