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_dle_xml
 216 {
 217     my ( $hostname, $disk, $dle ) = @_;
 218     return make_xml_elt(
 219         "dle",
 220         sub {
 221             return join( xml_nl(),
 222                 make_xml_elt( "hostname", $hostname ),
 223                 make_xml_elt( "disk",     $disk ),
 224                 ( defined $dle->{estimate} && %{ $dle->{estimate} } > 0 )
 225                 ? make_estimate_xml( $dle->{estimate} )
 226                 : (),
 227                 exists $dle->{tries} ? map { make_try_xml($_) }
 228                   @{ $dle->{tries} } : (),
 229                 exists $dle->{parts} ? map { make_part_xml($_) }
 230                   @{ $dle->{parts} } : () );
 231         }
 232     );
 233 }
 234
 235 sub make_program_xml
 236 {
 237     my ( $program_name, $program, $content ) = @_;
 238     return make_xml_elt(
 239         $program_name,
 240         sub {
 241             return join(
 242                 xml_nl(),
 243                 $content->(),
 244                 ( exists $program->{notes} )
 245                 ? make_list_xml( "notes", "note", @{ $program->{notes} } )
 246                 : (),
 247                 ( exists $program->{stranges} )
 248                 ? make_list_xml( "stranges", "strange",
 249                     @{ $program->{stranges} } )
 250                 : (),
 251                 ( exists $program->{errors} )
 252                 ? make_list_xml( "errors", "error", @{ $program->{errors} } )
 253                 : (),
 254             );
 255         }
 256     );
 257 }
 258
 259 sub make_planner_xml
 260 {
 261     my ($planner) = @_;
 262     return make_program_xml(
 263         "planner", $planner,
 264         sub {
 265             return join( xml_nl(),
 266                 make_xml_elt( "time",       $planner->{time} ),
 267                 make_xml_elt( "start",      $planner->{start} ),
 268                 make_xml_elt( "start_time", $planner->{start_time} ) );
 269         }
 270     );
 271 }
 272
 273 sub make_driver_xml
 274 {
 275     my ($driver) = @_;
 276     return make_program_xml(
 277         "driver", $driver,
 278         sub {
 279             return join( xml_nl(),
 280                 make_xml_elt( "time",  $driver->{time} ),
 281                 make_xml_elt( "start", $driver->{start} ) );
 282         }
 283     );
 284 }
 285
 286 sub make_dumper_program_xml
 287 {
 288     my ($dumper) = @_;
 289     return make_program_xml( "dumper", $dumper, sub { return ""; } );
 290 }
 291
 292 sub make_chunker_program_xml
 293 {
 294     my ($chunker) = @_;
 295     return make_program_xml( "chunker", $chunker, sub { return ""; } );
 296 }
 297
 298 sub make_tape_xml
 299 {
 300     my ( $tape_name, $tape ) = @_;
 301     return make_xml_elt(
 302         "tape",
 303         sub {
 304             return join(
 305                 xml_nl(),
 306                 make_xml_elt( "name", $tape_name ),
 307                 make_xml_elt( "date", $tape->{date} ),
 308                 defined $tape->{files}
 309                 ? make_xml_elt( "files", $tape->{files} )
 310                 : (),
 311                 defined $tape->{kb}
 312                 ? make_xml_elt( "bytes", $tape->{kb} * 1024 )
 313                 : ()
 314             );
 315         }
 316     );
 317 }
 318
 319 sub make_tapelist_xml
 320 {
 321     my ($tapelist) = @_;
 322     return make_xml_elt(
 323         "tapelist",
 324         sub {
 325             return join(
 326                 xml_nl(),
 327                 map { make_tape_xml( $_, $tapelist->{$_} ) } keys %$tapelist
 328             );
 329         }
 330     );
 331 }
 332
 333 sub make_taper_program_xml
 334 {
 335     my ($taper) = @_;
 336     return make_program_xml(
 337         "taper", $taper,
 338         sub {
 339             return
 340               defined $taper->{tapes}
 341               ? make_tapelist_xml( $taper->{tapes} )
 342               : ();
 343         }
 344     );
 345 }
 346
 347 #
 348 # Note: make_program_xml is a super-type for the individual programs,
 349 # make_programs_xml is the element container for the programs
 350 #
 351 sub make_programs_xml
 352 {
 353     my ($programs) = @_;
 354
 355     return make_xml_elt(
 356         "programs",
 357         sub {
 358             return join( xml_nl(),
 359                 exists $programs->{planner}
 360                 ? make_planner_xml( $programs->{planner} )
 361                 : (),
 362                 exists $programs->{driver}
 363                 ? make_driver_xml( $programs->{driver} )
 364                 : (),
 365                 exists $programs->{dumper}
 366                 ? make_dumper_program_xml( $programs->{dumper} )
 367                 : (),
 368                 exists $programs->{chunker}
 369                 ? make_chunker_program_xml( $programs->{chunker} )
 370                 : (),
 371                 exists $programs->{taper}
 372                 ? make_taper_program_xml( $programs->{taper} )
 373                 : () );
 374         }
 375     );
 376 }
 377
 378 1;
 379 __END__
 380
 381 =head1 NAME
 382
 383 Amanda::Report::xml - output Amanda::Report objects in xml format
 384
 385 =head1 SYNOPSIS
 386
 387    use Amanda::Report;
 388    my $report = Amanda::Report->new($logfile);
 389    print $report->output_xml();
 390
 391 =head1 DESCRIPTION
 392
 393 Stub documentation for Amanda::Report::xml,
 394
 395 Blah blah blah.
 396
 397 =head2 EXPORT
 398
 399 None by default.
 400
 401 =head1 SEE ALSO
 402
 403 Mention other useful documentation such as the documentation of
 404 related modules or operating system documentation (such as man pages
 405 in UNIX), or any relevant external documentation such as RFCs or
 406 standards.
 407
 408 If you have a mailing list set up for your module, mention it here.
 409
 410 If you have a web site set up for your module, mention it here.
 411
 412 =head1 AUTHOR
 413
 414 Paul C Mantz, E<lt>pcmantz@zmanda.comE<gt>
 415
 416 =head1 BUGS
 417
 418 None reported... yet.
 419
 420 =cut