diff -ur Audio.orig/Wav/Read.pm Audio/Wav/Read.pm
--- Audio.orig/Wav/Read.pm	2004-12-12 13:09:01.000000000 +0000
+++ Audio/Wav/Read.pm	2004-12-16 20:52:14.455453294 +0000
@@ -4,7 +4,7 @@
 use FileHandle;
 
 use vars qw( $VERSION );
-$VERSION = '0.02';
+$VERSION = '0.03';
 
 =head1 NAME
 
@@ -104,6 +104,97 @@
     return $self -> {'data'} -> {'info'};
 }
 
+# PeP hic facet 12/12/2004
+
+=head2 get_bext
+
+Returns Broadcast Extensionn information contained within the wav file.
+
+    my $info = $read -> get_bext();
+
+Returns a reference to a hash containing something like;
+
+    {
+	  'originator_reference' => 	'TEST file #1',
+          'version' => 			'',
+          'originator' => 		'SR',
+          'description' => 		'BWF version one testfile from The European Broadcasting Union and Swedish Radio 2004',
+          'coding_history' => 		'A=PCM,F=48000,W=16,M=stereo
+					 A=PCM,F=48000,W=16,M=stereo,T=D.A.V.I.D. GmbH Audio Conversion Software V7.00',
+                      			'time_reference' => 1984500000,
+                      			'umid' => <some hex string>,
+					'origination_date' => '2004-03-05',
+                      			'origination_time' => '10:31:58'
+	};
+
+	More information on the BWAV extensions can be found at:
+	
+	http://www.sr.se/utveckling/tu/bwf/index.htm (including "gold" test files)
+	http://www.ebu.ch/en/technical/publications/tech3000_series/index.php
+	
+	There are related SMPTE docs relating to generation of the UMIDs but I've yet
+	to work on that part
+	
+=cut
+
+sub get_bext {
+    my $self = shift;
+    return undef unless exists( $self -> {'data'} -> {'bext'} );
+    return $self -> {'data'} -> {'bext'};
+}
+
+=head2 get_levl
+
+Returns level Extension information contained within the wav file.
+
+    my $info = $read -> get_levl();
+
+Returns a reference to a hash containing something like;
+
+          {
+                      'peakChannels' => 2,
+                      'blockSize' => 256,
+                      'version' => 0,
+                      'numPeakFrames' => 18536,
+                      'format' => 'unsigned short',
+                      'points_per_value' => 'positive and negative peak points',
+                      'timestamp' => '2004:03:05:10:31:55:915oC',
+                      'peakData' => <very long binary string>,
+                      'posPeakOfPeaks' => 3706418,
+                      'lenPeakData' => 148347,
+                      'offsetToPeaks' => 128
+           };
+
+=cut
+
+sub get_levl {
+    my $self = shift;
+    return undef unless exists( $self -> {'data'} -> {'levl'} );
+    return $self -> {'data'} -> {'levl'};
+}
+
+=head2 get_fact
+
+Returns fact Extension information contained within the wav file.
+
+    my $info = $read -> get_fact();
+
+Returns a reference to a hash containing something like;
+
+       		{
+                      'sample_count' => 593280
+                };
+  
+=cut
+
+sub get_fact {
+    my $self = shift;
+    return undef unless exists( $self -> {'data'} -> {'fact'} );
+    return $self -> {'data'} -> {'fact'};
+}
+
+# PeP ends
+
 =head2 get_cues
 
 Returns the cuepoints marked within the wav file.
@@ -394,6 +485,16 @@
 		} elsif ( $head eq 'DISP' ) {
 		    $details{'display'} = $self -> _read_disp( $chunk_len );
 		    next;
+# PeP hic facet 12/12/2004 - Broadcast WAV extensions
+		} elsif ( $head eq 'bext' ) {
+		    $details{'bext'} = $self -> _read_bext( $chunk_len );
+		    next;
+		} elsif ( $head eq 'fact' ) {
+		    $details{'fact'} = $self -> _read_fact( $chunk_len );
+		    next;
+		} elsif ( $head eq 'levl' ) {
+		    $details{'levl'} = $self -> _read_levl( $chunk_len );
+		    next;
 		} elsif ( $head eq 'data' ) {
 		    $details{'data_start'} = $self -> {'pos'};
 		    $details{'data_length'} = $chunk_len;
@@ -557,6 +658,74 @@
     return $record;
 }
 
+# PeP hic facet 12/12/2004 - Broadcast WAV extensions
+sub _read_bext {
+	my $self = shift;
+	my $length = shift;
+	my $record;
+
+	$record -> { 'description' } = $self -> _read_raw( 256 );
+	$record -> { 'originator' } = $self -> _read_raw( 32 );
+	$record -> { 'originator_reference' } = $self -> _read_raw( 32 );
+	$record -> { 'origination_date' } = $self -> _read_raw( 10 );
+	$record -> { 'origination_time' } = $self -> _read_raw( 8 );
+	$record -> { 'time_reference' } = $self -> _read_long();  # 4
+	$record -> { 'version' } = $self -> _read_raw( 1 );
+	$record -> { 'umid' } = $self ->  _read_raw( 64 );
+	my $bitbucket = $self -> _read_raw( 190 );
+	$record -> { 'coding_history' } = $self -> _read_raw( $length  - 597 );
+
+	return $record;
+}
+
+sub _read_fact {
+	my $self = shift;
+	my $length = shift;
+	my $record;
+	
+	if ( $length == 4 ) {
+	  $record -> { 'sample_count' } = $self -> _read_long();
+	}
+        return $record
+}
+    
+
+sub _read_levl {
+	my $self = shift;
+	my $length = shift;
+	my $record;
+	
+	$record -> { 'version' } = $self -> _read_long( );
+	$record -> { 'format' } = $self -> _read_long( );
+	$record -> { 'points_per_value' }  = $self -> _read_long( );
+	$record -> { 'blockSize' } = $self -> _read_long();
+	$record -> { 'peakChannels' } = $self -> _read_long();
+	$record -> { 'numPeakFrames' } = $self -> _read_long();
+	$record -> { 'posPeakOfPeaks' } = $self -> _read_long();
+	$record -> { 'offsetToPeaks' } = $self -> _read_long();
+	$record -> { 'timestamp' } = $self -> _read_raw( 28 );
+	my $reserved = $self -> _read_raw( 1 );
+	$record -> { 'lenPeakData' } = $length - 61;
+	$record -> { 'peakData' } = $self -> _read_raw( $length - 61 );
+	return $record;
+}
+
+# For debug purposes....
+sub _print_hex {
+    my $self = shift;
+    my $input = shift;
+    my $length = shift;
+    my $expanded;
+    my $item;
+    
+    foreach $item ( split(//, $input, $length)) {
+      $expanded .= sprintf("%02x ", ord($item));
+    }
+       
+    return $expanded;
+}
+
+# PeP ends	
 
 sub _decode_block {
     my $self = shift;
@@ -616,7 +785,8 @@
 
     Nick Peskett <cpan@peskett.com>.
     Kurt George Gjerde <kurt.gjerde@media.uib.no>. (0.02)
-
+    Phil Packer <philp@layer3.co.uk> (v0.03 -Broadcast WAV extensions)
+    
 =cut
 
 1;
diff -ur Audio.orig/Wav/Tools.pm Audio/Wav/Tools.pm
--- Audio.orig/Wav/Tools.pm	2004-12-16 20:52:56.606815000 +0000
+++ Audio/Wav/Tools.pm	2004-12-16 20:52:14.503445736 +0000
@@ -3,7 +3,7 @@
 use strict;
 
 use vars qw( $VERSION );
-$VERSION = '0.02';
+$VERSION = '0.03';
 
 sub new {
     my $class = shift;
@@ -159,5 +159,61 @@
     };
 }
 
+# PeP hic facet
+
+# helper functions
+use Time::localtime;
+
+sub __nice_date {
+    my $self = shift;
+    return sprintf("%04d-%02d-%02d", localtime->year()+1900,
+    				     localtime->mon(),
+				     localtime->mday()
+                                   );
+}
+
+sub __nice_time {
+  my $self = shift;
+  return sprintf("%02d-%02d-%02d",localtime->hour(), 
+  				  localtime->min(),
+				  localtime->sec()
+				);
+
+}
+
+# PeP hic facet
+
+sub get_bext_fields {
+    my $self = shift;
+    return {
+	    'order'	=> [ qw( description originator originator_reference origination_date origination_time time_reference version umid  reserved coding_history) ],
+	    'types'	=> {
+			    'description'     		=> 'a256',
+			    'originator'    		=> 'a32',
+			    'originator_reference' 	=> 'a32',
+			    'origination_date'   	=> 'A10',
+			    'origination_time' 		=> 'A8',
+			    'time_reference' 		=> 'V2',
+			    'version'			=> 'V',
+			    'umid'			=> 'a64',  # maybe?
+			    'reserved'			=> 'x190',
+# NB Coding history is variable length so deliberately not referenced here	    
+			   },
+	    'defaults'	=> {
+	    		    'description'		=> 'Produced by PERL Audio::Wav module',
+			    'originator'		=> 'Audio::Wav',
+			    'originator_reference'	=> 'Originator Reference',
+			    'origination_date'		=> __nice_date(),
+			    'origination_time'		=> __nice_time(),
+			    'time_reference' 		=> '0',
+			    'version'			=> '0',
+			    'umid'			=> 0,  # maybe?
+			    'reserved'			=> 0,
+# NB but Coding history can be initialised...
+			    'coding_history'		=> '',
+			   }, 
+    };
+}
+
 
 1;
diff -ur Audio.orig/Wav/Write/Header.pm Audio/Wav/Write/Header.pm
--- Audio.orig/Wav/Write/Header.pm	2004-12-12 21:25:35.000000000 +0000
+++ Audio/Wav/Write/Header.pm	2004-12-16 20:52:14.370466678 +0000
@@ -2,7 +2,7 @@
 
 use strict;
 use vars qw($VERSION);
-$VERSION = '0.02';
+$VERSION = '0.03';
 
 sub new {
     my $class = shift;
@@ -59,6 +59,9 @@
     $extra += $self -> _write_cues();
     $extra += $self -> _write_list_adtl();
     $extra += $self -> _write_display();
+    # PeP hic facet
+    $extra += $self -> _write_fact();
+    $extra += $self -> _write_bext();
     $extra += $self -> _write_sampler_info();
 
     my $whole_num = pack( 'V', $self -> {'total'} + $data_size + $data_pad + $extra );  #includes padding
@@ -96,6 +99,30 @@
     return 1;
 }
 
+# PeP hic facet
+sub add_fact {
+    my $self = shift;
+    my %hash = @_;
+    $self -> { 'fact' } = { %hash };
+    return 1;
+}
+
+# PeP hic facet
+sub add_bext {
+    my $self = shift;
+    my %hash =  @_;
+    my $types = $self -> {'tools'} -> get_bext_fields();
+    foreach my $field ( @{ $types->{'order'} } ) {
+    	# loop if there's already a value set by the caller
+	next if defined $hash{$field};
+    	my $default = $types -> {'defaults'} ->{$field};
+	$hash{$field} = $default;
+    }
+    $self -> {'bext'} = \%hash;
+    return 1;
+}   
+
+
 sub set_sampler_info {
     my $self = shift;
     my %hash = @_;
@@ -229,6 +256,44 @@
     return $self -> _write_block( 'smpl', $output );
 }
 
+# PeP hic facet
+# Write the FACT chunk
+sub _write_fact {
+    my $self = shift;
+    my $output = '';
+    return 0 unless exists( $self -> {'fact'} );
+    my $sample_count = $self -> { 'fact' } -> { 'sample_count'};
+    if (defined $sample_count) {
+      $output .= pack('V', $sample_count);
+    }
+    return $self -> _write_block('fact', $output);
+}
+
+sub _write_bext {
+    my $self = shift;
+    my $output = '';
+    return 0 unless exists( $self -> { 'bext' } );
+    my $bext = $self -> { 'bext' };
+    my $types = $self -> {'tools'} -> get_bext_fields();
+    foreach my $type ( @{ $types -> {'order'} } ) {
+        my $val = $bext->{$type};
+	if (defined $val) {
+	  my $format = $types -> {'types'} -> {$type};
+          if (defined $format) {
+            $output .= pack( $format, $val );
+	  }
+	}
+    }
+    # Deal with coding_history separately
+    my $coding_history = $bext-> { 'coding_history' };
+    my $coding_history_len = length($coding_history);
+      
+    $output .= pack("a$coding_history_len" , $bext -> { 'coding_history' } );
+    return $self -> _write_block('bext', $output);
+  
+}
+
+
 sub _write_display {
     my $self = shift;
     return 0 unless exists( $self -> {'display'} );
diff -ur Audio.orig/Wav/Write.pm Audio/Wav/Write.pm
--- Audio.orig/Wav/Write.pm	2004-12-16 20:46:53.207044000 +0000
+++ Audio/Wav/Write.pm	2004-12-16 20:52:14.298478015 +0000
@@ -4,7 +4,7 @@
 use FileHandle;
 use Audio::Wav::Write::Header;
 use vars qw( $VERSION );
-$VERSION = '0.02';
+$VERSION = '0.03';
 
 
 my @needed = qw( bits_sample channels sample_rate );
@@ -221,6 +221,54 @@
     $self -> {'details'} -> {'info'} = { %{ $self -> {'details'} -> {'info'} }, %info };
 }
 
+=head2 add_fact
+
+Only currently defined parameter is "sample count":
+
+    $write -> add_fact( 'sample_count' => 123456 );
+
+=cut
+
+sub add_fact {
+   my $self = shift;
+   return $self -> {'header'} -> add_fact( @_ );
+}
+
+=head2 add_bext
+
+All parameters are optional.
+
+   my %info =  (
+	  'originator_reference' => 	'TEST file #1',
+          'version' => 			'',
+          'originator' => 		'SR',
+          'description' => 		'BWF version one testfile from The European Broadcasting Union and Swedish Radio 2004',
+          'coding_history' => 		'A=PCM,F=48000,W=16,M=stereo
+					 A=PCM,F=48000,W=16,M=stereo,T=D.A.V.I.D. GmbH Audio Conversion Software V7.00',
+                      			'time_reference' => 1984500000,
+                      			'umid' => <some hex string>,
+					'origination_date' => '2004-03-05',
+                      			'origination_time' => '10:31:58'
+	);
+    $write -> add_bext( %info );
+
+    More information on the BWAV extensions can be found at:
+	
+    http://www.sr.se/utveckling/tu/bwf/index.htm (including "gold" test files)
+    http://www.ebu.ch/en/technical/publications/tech3000_series/index.php
+	
+    There are related SMPTE docs relating to generation of the UMIDs but I've yet
+    to work on that part
+    
+=cut
+
+sub add_bext {
+    my $self = shift;
+    return $self -> {'header'} -> add_bext( @_ );
+}
+
+
+
 =head2 file_name
 
 Returns the current filename.
@@ -387,6 +435,7 @@
 
     Nick Peskett <cpan@peskett.com>.
     Kurt George Gjerde <kurt.gjerde@media.uib.no>. (0.02)
+    Phil Packer <philp@layer3.co.uk> (v0.03 -Broadcast WAV extensions)
 
 =cut
 
