diff --git a/CPAN/arch/5.42/Audio/Cuefile/Parser.pm b/CPAN/arch/5.42/Audio/Cuefile/Parser.pm new file mode 100644 index 00000000000..430512952ae --- /dev/null +++ b/CPAN/arch/5.42/Audio/Cuefile/Parser.pm @@ -0,0 +1,286 @@ +package Audio::Cuefile::Parser; + +=head1 NAME + +Audio::Cuefile::Parser + +=head1 VERSION + +Version 0.02 + +=cut + +our $VERSION = '0.02'; + +=head1 SYNOPSIS + +Class to parse a cuefile and access the chewy, nougat centre. +Returns Audio::Cuefile::Parser::Track objects. + +=head1 USAGE + +use Audio::Cuefile::Parser; + +my $filename = 'filename.cue'; + +my $cue = Audio::Cuefile::Parser->new($filename); + +my ($audio_file, $cd_performer, $cd_title) = + ($cue->file, $cue->performer, $cue->title); + +foreach my $track ($cue->tracks) { + + my ($position, $index, $performer, $title) = + ($track->position, $track->index, $track->performer, $track->title); + + print "$position $index $performer $title"; +} + +=cut + +use warnings; +use strict; + +use Carp qw/croak/; +use Class::Struct qw/struct/; +use IO::File; + +# Class specifications +BEGIN { + struct 'Audio::Cuefile::Parser' => { + cuedata => '$', + cuefile => '$', + file => '$', + performer => '$', + title => '$', + _tracks => '@', + }; + + struct 'Audio::Cuefile::Parser::Track' => { + index => '$', + performer => '$', + position => '$', + title => '$', + }; +} + +{ + # Over-ride Class::Struct's constructor so + # we can install some custom subs + no warnings 'redefine'; + + sub new { + my $class = shift or croak 'usage: '.__PACKAGE__.'->new($filename)'; + my $cuefile = shift or croak 'no cue file specified'; + -e $cuefile or croak "$cuefile does not exist"; + + my $self = bless {}, $class; + + $self->cuefile($cuefile); + + $self->_loadcue; + $self->_parse; + + return $self; + } +} + +# Load .cue file's contents into memory +sub _loadcue { + my $self = shift; + my $cuefile = $self->cuefile; + + my $data = join "", + IO::File->new($cuefile, 'r')->getlines; + + $self->cuedata($data); +} + +# Parse text and dispatch headers and data into +# their respective methods +sub _parse { + my $self = shift; + + my $data = $self->cuedata or return; + + my ($header, $tracks) = ( + $data =~ m{ + \A # start of string + (.*?) # capture all header text + (^ \s* TRACK .*) # capture all tracklist text + \z # end of string + }xms + ); + + $self->_parse_header($header); + $self->_parse_tracks($tracks); +} + +# Process each pair and dispatch +# value to object mutator +sub _parse_header { + my ($self, $header) = @_; + + $header or return; + + my @lines = split /\r*\n/, $header; + + + LINE: + foreach my $line (@lines) { + _strip_spaces($line); + + $line =~ m/\S/ or next LINE; + + my ($keyword, $data) = ( + $line =~ m/ + \A # anchor at string beginning + (\w+) # capture keyword (e.g. FILE, PERFORMER, TITLE) + \s+ ['"]? # optional quotes + (.*?) # capture all text as keyword's value + (?: # non-capture cluster + ['"] # quote, followed by + (?: + \s+ # spacing, followed by + \w+ # word (e.g. MP3, WAVE) + )? # make cluster optional + )? + \z # anchor at line end + /xms + ); + + ($keyword && $data) or next LINE; + + $keyword = lc $keyword; + + my %ISKEYWORD = map { $_ => 1 } qw/file performer title/; + + if ( $ISKEYWORD{$keyword} ) { + # print "\$self->$keyword($data)\n"; + $self->$keyword($data); + } + } +} + +# Walk through the track data, line by line, +# creating track objects and populating them +# as we go +sub _parse_tracks { + my ($self, $tracks) = @_; + + $tracks or return; + + my @lines = split /\r*\n/, $tracks; + + my @tracks; + + foreach my $line (@lines) { + _strip_spaces($line); + + # TRACK 01 + # TRACK 02 AUDIO + $line =~ /\A TRACK \s+ (\d+) .* \z/xms + and push @tracks, Audio::Cuefile::Parser::Track->new(position => $1); + + next unless @tracks; + + # TITLE Track Name + # TITLE "Track Name" + # TITLE 'Track Name' + $line =~ /\A TITLE \s+ ['"]? (.*?) ['"]? \z/xms + and $tracks[-1]->title($1); + + # PERFORMER Artist Name + # PERFORMER "Artist Name" + # PERFORMER 'Artist Name' + $line =~ /\A PERFORMER \s+ ['"]? (.*?) ['"]? \z/xms + and $tracks[-1]->performer($1); + + # INDEX 01 06:32:20 + $line =~ /\A INDEX \s+ (?: \d+ \s+) ([\d:]+) \z/xms + and $tracks[-1]->index($1); + } + + # Store them for safe keeping + $self->_tracks(\@tracks); +} + +sub tracks { + @{ shift->_tracks }; +} + +# strip leading and trailing whitespace from input string +sub _strip_spaces { + $_[0] =~ s/ + (?: + \A \s+ + | + \s+ \z + ) + //xms; +} + +=head1 CUEFILE METHODS + +=head2 $cue->tracks + +Returns a list of Audio::Cuefile::Parser::Track objects. + +=head2 $cue->file + +Returns the filename associated with the FILE keyword from +the .cue's headers (i.e. the audio file that the .cue file +is describing). + +=head2 $cue->performer + +The audio file's performer. + +=head2 $cue->title + +The title of the audio file. + +=head1 TRACK METHODS + +=head2 $track->index + +Timestamp that signifies the track's beginning. + +=head2 $track->performer + +The track's performer. + +=head2 $track->position + +The track's position in the audio file. + +=head2 $track->title + +Track title. + +=cut + +=head1 AUTHOR + +Matt Koscica + +=head1 BUGS + +Probably a few, the regexes are very simple. + +Please report any bugs or feature requests to +C, or through the web interface at +L. +I will be notified, and then you'll automatically be notified of progress on +your bug as I make changes. + +=head1 COPYRIGHT & LICENSE + +Copyright 2005-2010 Matt Koscica, all rights reserved. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + +1; # End of Audio::Cuefile::Parser diff --git a/CPAN/arch/5.42/Audio/Scan.pm b/CPAN/arch/5.42/Audio/Scan.pm new file mode 100644 index 00000000000..6ab8fe12707 --- /dev/null +++ b/CPAN/arch/5.42/Audio/Scan.pm @@ -0,0 +1,939 @@ +package Audio::Scan; + +use strict; + +our $VERSION = '1.11'; + +require XSLoader; +XSLoader::load('Audio::Scan', $VERSION); + +use constant FILTER_INFO_ONLY => 1; +use constant FILTER_TAGS_ONLY => 2; + +sub scan_info { + my ( $class, $path, $opts ) = @_; + + $opts ||= {}; + $opts->{filter} = FILTER_INFO_ONLY; + + $class->scan( $path, $opts ); +} + +sub scan_tags { + my ( $class, $path, $opts ) = @_; + + $opts ||= {}; + $opts->{filter} = FILTER_TAGS_ONLY; + + $class->scan( $path, $opts ); +} + +sub scan { + my ( $class, $path, $opts ) = @_; + + my ($filter, $md5_size, $md5_offset); + + open my $fh, '<', $path or do { + warn "Could not open $path for reading: $!\n"; + return; + }; + + binmode $fh; + + my ($suffix) = $path =~ /\.(\w+)$/; + + return if !$suffix; + + if ( defined $opts ) { + if ( !ref $opts ) { + # Back-compat to support filter as normal argument + warn "The Audio::Scan::scan() filter passing method is deprecated, please pass a hashref instead.\n"; + $filter = $opts; + } + else { + $filter = $opts->{filter} || FILTER_INFO_ONLY | FILTER_TAGS_ONLY; + $md5_size = $opts->{md5_size}; + $md5_offset = $opts->{md5_offset}; + } + } + + if ( !defined $filter ) { + $filter = FILTER_INFO_ONLY | FILTER_TAGS_ONLY; + } + + my $ret = $class->_scan( $suffix, $fh, $path, $filter, $md5_size || 0, $md5_offset || 0 ); + + close $fh; + + return $ret; +} + +sub scan_fh { + my ( $class, $suffix, $fh, $opts ) = @_; + + my ($filter, $md5_size, $md5_offset); + + binmode $fh; + + if ( defined $opts ) { + if ( !ref $opts ) { + # Back-compat to support filter as normal argument + warn "The Audio::Scan::scan_fh() filter passing method is deprecated, please pass a hashref instead.\n"; + $filter = $opts; + } + else { + $filter = $opts->{filter} || FILTER_INFO_ONLY | FILTER_TAGS_ONLY; + $md5_size = $opts->{md5_size}; + $md5_offset = $opts->{md5_offset}; + } + } + + if ( !defined $filter ) { + $filter = FILTER_INFO_ONLY | FILTER_TAGS_ONLY; + } + + return $class->_scan( $suffix, $fh, '(filehandle)', $filter, $md5_size || 0, $md5_offset || 0 ); +} + +sub find_frame { + my ( $class, $path, $offset ) = @_; + + open my $fh, '<', $path or do { + warn "Could not open $path for reading: $!\n"; + return; + }; + + binmode $fh; + + my ($suffix) = $path =~ /\.(\w+)$/; + + return -1 if !$suffix; + + my $ret = $class->_find_frame( $suffix, $fh, $path, $offset ); + + close $fh; + + return $ret; +} + +sub find_frame_fh { + my ( $class, $suffix, $fh, $offset ) = @_; + + binmode $fh; + + return $class->_find_frame( $suffix, $fh, '(filehandle)', $offset ); +} + +sub find_frame_return_info { + my ( $class, $path, $offset ) = @_; + + open my $fh, '<', $path or do { + warn "Could not open $path for reading: $!\n"; + return; + }; + + binmode $fh; + + my ($suffix) = $path =~ /\.(\w+)$/; + + return if !$suffix; + + my $ret = $class->_find_frame_return_info( $suffix, $fh, $path, $offset ); + + close $fh; + + return $ret; +} + +sub find_frame_fh_return_info { + my ( $class, $suffix, $fh, $offset ) = @_; + + binmode $fh; + + return $class->_find_frame_return_info( $suffix, $fh, '(filehandle)', $offset ); +} + +1; +__END__ + +=head1 NAME + +Audio::Scan - Fast C metadata and tag reader for all common audio file formats + +=head1 SYNOPSIS + + use Audio::Scan; + + my $data = Audio::Scan->scan('/path/to/file.mp3'); + + # Just file info + my $info = Audio::Scan->scan_info('/path/to/file.mp3'); + + # Just tags + my $tags = Audio::Scan->scan_tags('/path/to/file.mp3'); + + # Scan without reading (possibly large) artwork into memory. + # Instead of binary artwork data, the size of the artwork will be returned instead. + { + local $ENV{AUDIO_SCAN_NO_ARTWORK} = 1; + my $data = Audio::Scan->scan('/path/to/file.mp3'); + } + + # Scan a filehandle + open my $fh, '<', 'my.mp3'; + my $data = Audio::Scan->scan_fh( mp3 => $fh ); + close $fh; + + # Scan and compute an audio MD5 checksum + my $data = Audio::Scan->scan( '/path/to/file.mp3', { md5_size => 100 * 1024 } ); + my $md5 = $data->{info}->{audio_md5}; + +=head1 DESCRIPTION + +Audio::Scan is a C-based scanner for audio file metadata and tag information. It currently +supports MP3, MP4, Ogg Vorbis, FLAC, ASF, WAV, AIFF, Musepack, Monkey's Audio, and WavPack. + +See below for specific details about each file format. + +=head1 METHODS + +=head2 scan( $path, [ \%OPTIONS ] ) + +Scans $path for both metadata and tag information. The type of scan performed is +determined by the file's extension. Supported extensions are: + + MP3: mp3, mp2 + MP4: mp4, m4a, m4b, m4p, m4v, m4r, k3g, skm, 3gp, 3g2, mov + AAC (ADTS): aac + Ogg: ogg, oga + FLAC: flc, flac, fla + ASF: wma, wmv, asf + Musepack: mpc, mpp, mp+ + Monkey's Audio: ape, apl + WAV: wav + AIFF: aiff, aif + WavPack: wv + +This method returns a hashref containing two other hashrefs: info and tags. The +contents of the info and tag hashes vary depending on file format, see below for details. + +An optional hashref may be provided with the following values: + + md5_size => $audio_bytes_to_checksum + +An MD5 will be computed of the first N audio bytes. Any tags in the file are automatically +skipped, so this is a useful way of determining if a file's audio content is the same even +if tags may have been changed. The hex MD5 value is returned in the $info->{audio_md5} +key. This option will reduce performance, so choose a small enough size that works for you, +you should probably avoid using more than 64K for example. + +For FLAC files that already contain an MD5 checksum, this value will be used instead +of calculating a new one. + + md5_offset => $offset + +Begin computing the audio_md5 value starting at $offset. If this value is not specified, +$offset defaults to a point in the middle of the file. + +=head2 scan_info( $path, [ \%OPTIONS ] ) + +If you only need file metadata and don't care about tags, you can use this method. + +=head2 scan_tags( $path, [ \%OPTIONS ] ) + +If you only need the tags and don't care about the metadata, use this method. + +=head2 scan_fh( $type => $fh, [ \%OPTIONS ] ) + +Scans a filehandle. $type is the type of file to scan as, i.e. "mp3" or "ogg". +Note that FLAC does not support reading from a filehandle. + +=head2 find_frame( $path, $timestamp_in_ms ) + +Returns the byte offset to the first audio frame starting from the given timestamp +(in milliseconds). + +=over 4 + +=item MP3, Ogg, FLAC, ASF, MP4 + +The byte offset to the data packet containing this timestamp will be returned. For +file formats that don't provide timestamp information such as MP3, the best estimate for +the location of the timestamp will be returned. This will be more accurate if the +file has a Xing header or is CBR for example. + +=item WAV, AIFF, Musepack, Monkey's Audio, WavPack + +Not yet supported by find_frame. + +=back + +=head2 find_frame_return_info( $path, $timestamp_in_ms ) + +The header of an MP4/OggFlac file contains various metadata that refers to the structure of +the audio data, making seeking more difficult to perform. This method will return +the usual $info hash with 2 additional keys: + + seek_offset - The seek offset in bytes + seek_header - A rewritten MP4/OggFlac header that can be prepended to the audio data + found at seek_offset to construct a valid bitstream. Specifically, for MP4 + the following boxes are rewritten: stts, stsc, stsz, stco. For FLAC, the + number of samples and md5 in STREAMINFO are zero'd + +For example, to seek 30 seconds into a file and write out a new MP4 file seeked to +this point: + + my $info = Audio::Scan->find_frame_return_info( $file, 30000 ); + + open my $f, '<', $file; + sysseek $f, $info->{seek_offset}, 1; + + open my $fh, '>', 'seeked.m4a'; + print $fh $info->{seek_header}; + + while ( sysread( $f, my $buf, 65536 ) ) { + print $fh $buf; + } + + close $f; + close $fh; + +=head2 find_frame_fh( $type => $fh, $offset ) + +Same as C, but with a filehandle. + +=head2 find_frame_fh_return_info( $type => $fh, $offset ) + +Same as C, but with a filehandle. + +=head2 has_flac() + +Deprecated. Always returns 1 now that FLAC is always enabled. + +=head2 is_supported( $path ) + +Returns 1 if the given path can be scanned by Audio::Scan, or 0 if not. + +=head2 get_types() + +Returns an array of strings of the file types supported by Audio::Scan. + +=head2 extensions_for( $type ) + +Returns an array of strings of the file extensions that are considered to +be the file type I<$type>. + +=head2 type_for( $extension ) + +Returns file type for a given extension. Returns I for unsupported +extensions. + +=head1 SKIPPING ARTWORK + +To save memory while reading tags, you can opt to skip potentially large +embedded artwork. To do this, set the environment variable AUDIO_SCAN_NO_ARTWORK: + + local $ENV{AUDIO_SCAN_NO_ARTWORK} = 1; + my $tags = Audio::Scan->scan_tags($file); + +This will return the length of the embedded artwork instead of the actual image data. +In some cases it will also return a byte offset to the image data, which can be used +to extract the image using more efficient means. Note that the offset is not always +returned so if you want to use this data make sure to check for offset. If offset +is not present, the only way to get the image data is to perform a normal tag scan +without the environment variable set. + +One limitation that currently exists is that memory for embedded images is still +allocated for ASF and Ogg Vorbis files. + +This information is returned in different ways depending on the format: + +ID3 (MP3, AAC, WAV, AIFF): + + $tags->{APIC}->[3]: image length + $tags->{APIC}->[4]: image offset (unless APIC would need unsynchronization) + +MP4: + + $tags->{COVR}: image length + $tags->{COVR_offset}: image offset (always available) + +Ogg Vorbis: + + $tags->{ALLPICTURES}->[0]->{image_data}: image length + Image offset is not supported with Vorbis because the data is always base64-encoded. + +FLAC: + + $tags->{ALLPICTURES}->[0]->{image_data}: image length + $tags->{ALLPICTURES}->[0]->{offset}: image offset (always available) + +ASF: + + $tags->{'WM/Picture'}->{image}: image length + $tags->{'WM/Picture'}->{offset}: image offset (always available) + +APE, Musepack, WavPack, MP3 with APEv2: + + $tags->{'COVER ART (FRONT)'}: image length + $tags->{'COVER ART (FRONT)_offset'}: image offset (always available) + +=head1 MP3 + +=head2 INFO + +The following metadata about a file may be returned: + + id3_version (i.e. "ID3v2.4.0") + id3_was_unsynced (if a v2.2/v2.3 file needed whole-tag unsynchronization) + song_length_ms (duration in milliseconds) + layer (i.e. 3) + stereo + samples_per_frame + padding + audio_size (size of all audio frames) + audio_offset (byte offset to first audio frame) + bitrate (in bps, determined using Xing/LAME/VBRI if possible, or average in the worst case) + samplerate (in kHz) + vbr (1 if file is VBR) + dlna_profile (if file is compliant) + + If a Xing header is found: + xing_frames + xing_bytes + xing_quality + + If a VBRI header is found: + vbri_delay + vbri_frames + vbri_bytes + vbri_quality + + If a LAME header is found: + lame_encoder_version + lame_tag_revision + lame_vbr_method + lame_lowpass + lame_replay_gain_radio + lame_replay_gain_audiophile + lame_encoder_delay + lame_encoder_padding + lame_noise_shaping + lame_stereo_mode + lame_unwise_settings + lame_source_freq + lame_surround + lame_preset + +=head2 TAGS + +Raw tags are returned as found. This means older tags such as ID3v1 and ID3v2.2/v2.3 +are converted to ID3v2.4 tag names. Multiple instances of a tag in a file will be returned +as arrays. Complex tags such as APIC and COMM are returned as arrays. All tag fields are +converted to upper-case. All text is converted to UTF-8. + +Sample tag data: + + tags => { + ALBUMARTISTSORT => "Solar Fields", + APIC => [ "image/jpeg", 3, "", ], + CATALOGNUMBER => "INRE 017", + COMM => ["eng", "", "Amazon.com Song ID: 202981429"], + "MUSICBRAINZ ALBUM ARTIST ID" => "a2af1f31-c9eb-4fff-990c-c4f547a11b75", + "MUSICBRAINZ ALBUM ID" => "282143c9-6191-474d-a31a-1117b8c88cc0", + "MUSICBRAINZ ALBUM RELEASE COUNTRY" => "FR", + "MUSICBRAINZ ALBUM STATUS" => "official", + "MUSICBRAINZ ALBUM TYPE" => "album", + "MUSICBRAINZ ARTIST ID" => "a2af1f31-c9eb-4fff-990c-c4f547a11b75", + "REPLAYGAIN_ALBUM_GAIN" => "-2.96 dB", + "REPLAYGAIN_ALBUM_PEAK" => "1.045736", + "REPLAYGAIN_TRACK_GAIN" => "+3.60 dB", + "REPLAYGAIN_TRACK_PEAK" => "0.892606", + TALB => "Leaving Home", + TCOM => "Magnus Birgersson", + TCON => "Ambient", + TCOP => "2005 ULTIMAE RECORDS", + TDRC => "2004-10", + TIT2 => "Home", + TPE1 => "Solar Fields", + TPE2 => "Solar Fields", + TPOS => "1/1", + TPUB => "Ultimae Records", + TRCK => "1/11", + TSOP => "Solar Fields", + UFID => [ + "http://musicbrainz.org", + "1084278a-2254-4613-a03c-9fed7a8937ca", + ], + }, + + +=head1 MP4 + +=head2 INFO + +The following metadata about a file may be returned: + + audio_offset (byte offset to start of mdat) + audio_size + compatible_brands + file_size + leading_mdat (if file has mdat before moov) + major_brand + minor_version + song_length_ms + timescale + dlna_profile (if file is compliant) + tracks (array of tracks in the file) + Each track may contain: + + audio_type + avg_bitrate + bits_per_sample + channels + duration + encoding + handler_name + handler_type + id + max_bitrate + samplerate + +=head2 TAGS + +Tags are returned in a hash with all keys converted to upper-case. Keys starting with +0xA9 (copyright symbol) will have this character stripped out. Sample tag data: + + tags => { + AART => "Album Artist", + ALB => "Album", + ART => "Artist", + CMT => "Comments", + COVR => , + CPIL => 1, + DAY => 2009, + DESC => "Video Description", + DISK => "1/2", + "ENCODING PARAMS" => "vers\0\0\0\1acbf\0\0\0\2brat\0\1w\0cdcv\0\1\6\5", + GNRE => "Jazz", + GRP => "Grouping", + ITUNNORM => " 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000", + ITUNSMPB => " 00000000 00000840 000001E4 00000000000001DC 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000", + LYR => "Lyrics", + NAM => "Name", + PGAP => 1, + SOAA => "Sort Album Artist", + SOAL => "Sort Album", + SOAR => "Sort Artist", + SOCO => "Sort Composer", + SONM => "Sort Name", + SOSN => "Sort Show", + TMPO => 120, + TOO => "iTunes 8.1.1, QuickTime 7.6", + TRKN => "1/10", + TVEN => "Episode ID", + TVES => 12, + TVSH => "Show", + TVSN => 12, + WRT => "Composer", + }, + +=head1 AAC (ADTS) + +=head2 INFO + +The following metadata about a file is returned: + + audio_offset + audio_size + bitrate (in bps) + channels + file_size + profile (Main, LC, or SSR) + samplerate (in kHz) + song_length_ms (duration in milliseconds) + dlna_profile (if file is compliant) + +=head1 OGG VORBIS + +=head2 INFO + +The following metadata about a file is returned: + + version + channels + stereo + samplerate (in kHz) + bitrate_average (in bps) + bitrate_upper + bitrate_nominal + bitrate_lower + blocksize_0 + blocksize_1 + audio_offset (byte offset to audio) + audio_size + song_length_ms (duration in milliseconds) + +=head2 TAGS + +Raw Vorbis comments are returned. All comment keys are capitalized. + +=head1 FLAC + +=head2 INFO + +The following metadata about a file is returned: + + channels + samplerate (in kHz) + bitrate (in bps) + file_size + audio_offset (byte offset to first audio frame) + audio_size + song_length_ms (duration in milliseconds) + bits_per_sample + frames + minimum_blocksize + maximum_blocksize + minimum_framesize + maximum_framesize + audio_md5 + total_samples + +=head2 TAGS + +Raw FLAC comments are returned. All comment keys are capitalized. Some data returned is special: + +APPLICATION + + Each application block is returned in the APPLICATION tag keyed by application ID. + +CUESHEET_BLOCK + + The CUESHEET_BLOCK tag is an array containing each line of the cue sheet. + +ALLPICTURES + + Embedded pictures are returned in an ALLPICTURES array. Each picture has the following metadata: + + mime_type + description + width + height + depth + color_index + image_data + picture_type + +=head1 ASF (Windows Media Audio/Video) + +=head2 INFO + +The following metadata about a file may be returned. Reading the ASF spec is encouraged if you +want to find out more about any of these values. + + audio_offset (byte offset to first data packet) + audio_size + broadcast (boolean, whether the file is a live broadcast or not) + codec_list (array of information about codecs used in the file) + creation_date (UNIX timestamp when file was created) + data_packets + drm_key + drm_license_url + drm_protection_type + drm_data + file_id (unique file ID) + file_size + index_blocks + index_entry_interval (in milliseconds) + index_offsets (byte offsets for each second of audio, per stream. Useful for seeking) + index_specifiers (indicates which stream a given index_offset points to) + language_list (array of languages referenced by the file's metadata) + lossless (boolean) + max_bitrate + max_packet_size + min_packet_size + mutex_list (mutually exclusive stream information) + play_duration_ms + preroll + script_commands + script_types + seekable (boolean, whether the file is seekable or not) + send_duration_ms + song_length_ms (the actual length of the audio, in milliseconds) + dlna_profile (if file is compliant) + +STREAMS + +The streams array contains metadata related to an individul stream within the file. +The following metadata may be returned: + + DeviceConformanceTemplate + IsVBR + alt_bitrate + alt_buffer_fullness + alt_buffer_size + avg_bitrate (most accurate bitrate for this stream) + avg_bytes_per_sec (audio only) + bitrate + bits_per_sample (audio only) + block_alignment (audio only) + bpp (video only) + buffer_fullness + buffer_size + channels (audio only) + codec_id (audio only) + compression_id (video only) + encode_options + encrypted (boolean) + error_correction_type + flag_seekable (boolean) + height (video only) + index_type + language_index (offset into language_list array) + max_object_size + samplerate (in kHz) (audio only) + samples_per_block + stream_number + stream_type + super_block_align + time_offset + width (video only) + +=head2 TAGS + +Raw tags are returned. Tags that occur more than once are returned as arrays. +In contrast to the other formats, tag keys are NOT capitalized. There is one special key: + +WM/Picture + +Pictures are returned as a hash with the following keys: + + image_type (numeric type, same as ID3v2 APIC) + mime_type + description + image + +=head1 WAV + +=head2 INFO + +The following metadata about a file may be returned. + + audio_offset + audio_size + bitrate (in bps) + bits_per_sample + block_align + channels + dlna_profile (if file is compliant) + file_size + format (WAV format code, 1 == PCM) + id3_version (if an ID3v2 tag is found) + samplerate (in kHz) + song_length_ms + +=head2 TAGS + +WAV files can contain several different types of tags. "Native" WAV tags +found in a LIST block may include these and others: + + IARL - Archival Location + IART - Artist + ICMS - Commissioned + ICMT - Comment + ICOP - Copyright + ICRD - Creation Date + ICRP - Cropped + IENG - Engineer + IGNR - Genre + IKEY - Keywords + IMED - Medium + INAM - Name (Title) + IPRD - Product (Album) + ISBJ - Subject + ISFT - Software + ISRC - Source + ISRF - Source Form + TORG - Label + LOCA - Location + TVER - Version + TURL - URL + TLEN - Length + ITCH - Technician + TRCK - Track + ITRK - Track + +ID3v2 tags can also be embedded within WAV files. These are returned exactly as for MP3 files. + +=head1 AIFF + +=head2 INFO + +The following metadata about a file may be returned. + + audio_offset + audio_size + bitrate (in bps) + bits_per_sample + block_align + channels + compression_name (if AIFC) + compression_type (if AIFC) + dlna_profile (if file is compliant) + file_size + id3_version (if an ID3v2 tag is found) + samplerate (in kHz) + song_length_ms + +=head2 TAGS + +ID3v2 tags can be embedded within AIFF files. These are returned exactly as for MP3 files. + +=head1 MONKEY'S AUDIO (APE) + +=head2 INFO + +The following metadata about a file may be returned. + + audio_offset + audio_size + bitrate (in bps) + channels + compression + file_size + samplerate (in kHz) + song_length_ms + version + +=head2 TAGS + +APEv2 tags are returned as a hash of key/value pairs. + +=head1 MUSEPACK + +=head2 INFO + +The following metadata about a file may be returned. + + audio_offset + audio_size + bitrate (in bps) + channels + encoder + file_size + profile + samplerate (in kHz) + song_length_ms + +=head2 TAGS + +Musepack uses APEv2 tags. They are returned as a hash of key/value pairs. + +=head1 WAVPACK + +=head2 INFO + +The following metadata about a file may be returned. + + audio_offset + audio_size + bitrate (in bps) + bits_per_sample + channels + encoder_version + file_size + hybrid (1 if file is lossy) (v4 only) + lossless (1 if file is lossless) (v4 only) + samplerate + song_length_ms + total_samples + +=head2 TAGS + +WavPack uses APEv2 tags. They are returned as a hash of key/value pairs. + +=head1 DSF + +=head2 INFO + +The following metadata about a file may be returned. + + audio_offset + audio_size + bits_per_sample + channels + song_length_ms + samplerate + block_size_per_channel + +=head2 TAGS + +ID3v2 tags can be embedded within DSF files. These are returned exactly as for MP3 files. + +=head1 DSDIFF (DFF) + +=head2 INFO + +The following metadata about a file may be returned. + + audio_offset + audio_size + bits_per_sample + channels + song_length_ms + samplerate + tag_diti_title + tag_diar_artist + +=head2 TAGS + +No separate tags are supported by the DSDIFF format. + +=head1 + +=head1 THANKS + +Logitech & Slim Devices, for letting us release so much of our code to the world. +Long live Squeezebox! + +Kimmo Taskinen, Adrian Smith, Clive Messer, and Jurgen Kramer for +DSF/DSDIFF support and various other fixes. + +Some code from the Rockbox project was very helpful in implementing ASF and +MP4 seeking. + +Some of the file format parsing code was derived from the mt-daapd project, +and adapted by Netgear. It has been heavily rewritten to fix bugs and add +more features. + +The source to the original Netgear C scanner for SqueezeCenter is located +at L + +The audio MD5 feature uses an MD5 implementation by L. Peter Deutsch, +Eghost@aladdin.comE. + +=head1 SEE ALSO + +ASF Spec L + +MP4 Info: +L +L + +=head1 AUTHORS + +Andy Grundman, Eandy@hybridized.orgE + +Dan Sully, Edaniel@cpan.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2010-2011 Logitech, Inc. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +=cut diff --git a/CPAN/arch/5.42/Class/XSAccessor.pm b/CPAN/arch/5.42/Class/XSAccessor.pm new file mode 100644 index 00000000000..2ef7979005a --- /dev/null +++ b/CPAN/arch/5.42/Class/XSAccessor.pm @@ -0,0 +1,326 @@ +package Class::XSAccessor; +use 5.008; +use strict; +use warnings; +use Carp qw/croak/; +use Class::XSAccessor::Heavy; +use XSLoader; + +our $VERSION = '1.18'; + +XSLoader::load('Class::XSAccessor', $VERSION); + +sub _make_hash { + my $ref = shift; + + if (ref ($ref)) { + if (ref($ref) eq 'ARRAY') { + $ref = { map { $_ => $_ } @$ref } + } + } else { + $ref = { $ref, $ref }; + } + + return $ref; +} + +sub import { + my $own_class = shift; + my ($caller_pkg) = caller(); + + # Support both { getters => ... } and plain getters => ... + my %opts = ref($_[0]) eq 'HASH' ? %{$_[0]} : @_; + + $caller_pkg = $opts{class} if defined $opts{class}; + + # TODO: Refactor. Move more duplicated code to ::Heavy + my $read_subs = _make_hash($opts{getters} || {}); + my $set_subs = _make_hash($opts{setters} || {}); + my $acc_subs = _make_hash($opts{accessors} || {}); + my $lvacc_subs = _make_hash($opts{lvalue_accessors} || {}); + my $pred_subs = _make_hash($opts{predicates} || {}); + my $ex_pred_subs = _make_hash($opts{exists_predicates} || {}); + my $def_pred_subs = _make_hash($opts{defined_predicates} || {}); + my $test_subs = _make_hash($opts{__tests__} || {}); + my $construct_subs = $opts{constructors} || [defined($opts{constructor}) ? $opts{constructor} : ()]; + my $true_subs = $opts{true} || []; + my $false_subs = $opts{false} || []; + + foreach my $subtype ( ["getter", $read_subs], + ["setter", $set_subs], + ["accessor", $acc_subs], + ["lvalue_accessor", $lvacc_subs], + ["test", $test_subs], + ["ex_predicate", $ex_pred_subs], + ["def_predicate", $def_pred_subs], + ["def_predicate", $pred_subs] ) + { + my $subs = $subtype->[1]; + foreach my $subname (keys %$subs) { + my $hashkey = $subs->{$subname}; + _generate_method($caller_pkg, $subname, $hashkey, \%opts, $subtype->[0]); + } + } + + foreach my $subtype ( ["constructor", $construct_subs], + ["true", $true_subs], + ["false", $false_subs] ) + { + foreach my $subname (@{$subtype->[1]}) { + _generate_method($caller_pkg, $subname, "", \%opts, $subtype->[0]); + } + } +} + +sub _generate_method { + my ($caller_pkg, $subname, $hashkey, $opts, $type) = @_; + + croak("Cannot use undef as a hash key for generating an XS $type accessor. (Sub: $subname)") + if not defined $hashkey; + + $subname = "${caller_pkg}::$subname" if $subname !~ /::/; + + Class::XSAccessor::Heavy::check_sub_existence($subname) if not $opts->{replace}; + no warnings 'redefine'; # don't warn about an explicitly requested redefine + + if ($type eq 'getter') { + newxs_getter($subname, $hashkey); + } + elsif ($type eq 'lvalue_accessor') { + newxs_lvalue_accessor($subname, $hashkey); + } + elsif ($type eq 'setter') { + newxs_setter($subname, $hashkey, $opts->{chained}||0); + } + elsif ($type eq 'def_predicate') { + newxs_defined_predicate($subname, $hashkey); + } + elsif ($type eq 'ex_predicate') { + newxs_exists_predicate($subname, $hashkey); + } + elsif ($type eq 'constructor') { + newxs_constructor($subname); + } + elsif ($type eq 'true') { + newxs_boolean($subname, 1); + } + elsif ($type eq 'false') { + newxs_boolean($subname, 0); + } + elsif ($type eq 'test') { + newxs_test($subname, $hashkey); + } + else { + newxs_accessor($subname, $hashkey, $opts->{chained}||0); + } +} + +1; + +__END__ + +=head1 NAME + +Class::XSAccessor - Generate fast XS accessors without runtime compilation + +=head1 SYNOPSIS + + package MyClass; + use Class::XSAccessor + replace => 1, # Replace existing methods (if any) + constructor => 'new', + getters => { + get_foo => 'foo', # 'foo' is the hash key to access + get_bar => 'bar', + }, + setters => { + set_foo => 'foo', + set_bar => 'bar', + }, + accessors => { + foo => 'foo', + bar => 'bar', + }, + # "predicates" is an alias for "defined_predicates" + defined_predicates => { + defined_foo => 'foo', + defined_bar => 'bar', + }, + exists_predicates => { + has_foo => 'foo', + has_bar => 'bar', + }, + lvalue_accessors => { # see below + baz => 'baz', # ... + }, + true => [ 'is_token', 'is_whitespace' ], + false => [ 'significant' ]; + + # The imported methods are implemented in fast XS. + + # normal class code here. + +As of version 1.05, some alternative syntax forms are available: + + package MyClass; + + # Options can be passed as a HASH reference, if preferred, + # which can also help Perl::Tidy to format the statement correctly. + use Class::XSAccessor { + # If the name => key values are always identical, + # the following shorthand can be used. + accessors => [ 'foo', 'bar' ], + }; + +=head1 DESCRIPTION + +Class::XSAccessor implements fast read, write and read/write accessors in XS. +Additionally, it can provide predicates such as C for testing +whether the attribute C exists in the object (which is different from +"is defined within the object"). +It only works with objects that are implemented as ordinary hashes. +L implements the same interface for objects +that use arrays for their internal representation. + +Since version 0.10, the module can also generate simple constructors +(implemented in XS). Simply supply the +C 'constructor_name'> option or the +C ['new', 'create', 'spawn']> option. +These constructors do the equivalent of the following Perl code: + + sub new { + my $class = shift; + return bless { @_ }, ref($class)||$class; + } + +That means they can be called on objects and classes but will not +clone objects entirely. Parameters to C are added to the +object. + +The XS accessor methods are between 3 and 4 times faster than typical +pure-Perl accessors in some simple benchmarking. +The lower factor applies to the potentially slightly obscure +C{foo} = $_[1]}>, so if you usually +write clear code, a factor of 3.5 speed-up is a good estimate. +If in doubt, do your own benchmarking! + +The method names may be fully qualified. The example in the synopsis could +have been written as C instead +of C. This way, methods can be installed in classes other +than the current class. See also: the C option below. + +By default, the setters return the new value that was set, +and the accessors (mutators) do the same. This behaviour can be changed +with the C option - see below. The predicates return a boolean. + +Since version 1.01, C can generate extremely simple methods which +just return true or false (and always do so). If that seems like a +really superfluous thing to you, then consider a large class hierarchy +with interfaces such as L. These methods are provided by the C +and C options - see the synopsis. + +C check whether a given object attribute is defined. +C is an alias for C for compatibility with +older versions of C. C checks +whether the given attribute exists in the object using C. + +=head1 OPTIONS + +In addition to specifying the types and names of accessors, additional options +can be supplied which modify behaviour. The options are specified as key/value pairs +in the same manner as the accessor declaration. For example: + + use Class::XSAccessor + getters => { + get_foo => 'foo', + }, + replace => 1; + +The list of available options is: + +=head2 replace + +Set this to a true value to prevent C from +complaining about replacing existing subroutines. + +=head2 chained + +Set this to a true value to change the return value of setters +and mutators (when called with an argument). +If C is enabled, the setters and accessors/mutators will +return the object. Mutators called without an argument still +return the value of the associated attribute. + +As with the other options, C affects all methods generated +in the same C statement. + +=head2 class + +By default, the accessors are generated in the calling class. The +the C option allows the target class to be specified. + +=head1 LVALUES + +Support for lvalue accessors via the keyword C +was added in version 1.08. At this point, B. Furthermore, their performance hasn't been benchmarked +yet. + +The following example demonstrates an lvalue accessor: + + package Address; + use Class::XSAccessor + constructor => 'new', + lvalue_accessors => { zip_code => 'zip' }; + + package main; + my $address = Address->new(zip => 2); + print $address->zip_code, "\n"; # prints 2 + $address->zip_code = 76135; # <--- This is it! + print $address->zip_code, "\n"; # prints 76135 + +=head1 CAVEATS + +Probably won't work for objects based on I hashes. But that's a strange thing to do anyway. + +Scary code exploiting strange XS features. + +If you think writing an accessor in XS should be a laughably simple exercise, then +please contemplate how you could instantiate a new XS accessor for a new hash key +that's only known at run-time. Note that compiling C code at run-time a la L +is a no go. + +Threading. With version 1.00, a memory leak has been B. Previously, a small amount of +memory would leak if C-based classes were loaded in a subthread without having +been loaded in the "main" thread. If the subthread then terminated, a hash key and an int per +associated method used to be lost. Note that this mattered only if classes were B loaded +in a sort of throw-away thread. + +In the new implementation, as of 1.00, the memory will still not be released, in the same situation, +but it will be recycled when the same class, or a similar class, is loaded again in B thread. + +=head1 SEE ALSO + +=over + +=item * L + +=item * L + +=back + +=head1 AUTHOR + +Steffen Mueller Esmueller@cpan.orgE + +chocolateboy Echocolate@cpan.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 by Steffen Mueller + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8 or, +at your option, any later version of Perl 5 you may have available. + +=cut diff --git a/CPAN/arch/5.42/Class/XSAccessor/Array.pm b/CPAN/arch/5.42/Class/XSAccessor/Array.pm new file mode 100644 index 00000000000..05035bedb78 --- /dev/null +++ b/CPAN/arch/5.42/Class/XSAccessor/Array.pm @@ -0,0 +1,284 @@ +package Class::XSAccessor::Array; +use 5.008; +use strict; +use warnings; +use Carp qw/croak/; +use Class::XSAccessor; +use Class::XSAccessor::Heavy; + +our $VERSION = '1.18'; + +sub import { + my $own_class = shift; + my ($caller_pkg) = caller(); + + # Support both { getters => ... } and plain getters => ... + my %opts = ref($_[0]) eq 'HASH' ? %{$_[0]} : @_; + + $caller_pkg = $opts{class} if defined $opts{class}; + + my $read_subs = $opts{getters} || {}; + my $set_subs = $opts{setters} || {}; + my $acc_subs = $opts{accessors} || {}; + my $lvacc_subs = $opts{lvalue_accessors} || {}; + my $pred_subs = $opts{predicates} || {}; + my $construct_subs = $opts{constructors} || [defined($opts{constructor}) ? $opts{constructor} : ()]; + my $true_subs = $opts{true} || []; + my $false_subs = $opts{false} || []; + + + foreach my $subtype ( ["getter", $read_subs], + ["setter", $set_subs], + ["accessor", $acc_subs], + ["lvalue_accessor", $lvacc_subs], + ["pred_subs", $pred_subs] ) + { + my $subs = $subtype->[1]; + foreach my $subname (keys %$subs) { + my $array_index = $subs->{$subname}; + _generate_method($caller_pkg, $subname, $array_index, \%opts, $subtype->[0]); + } + } + + foreach my $subtype ( ["constructor", $construct_subs], + ["true", $true_subs], + ["false", $false_subs] ) + { + foreach my $subname (@{$subtype->[1]}) { + _generate_method($caller_pkg, $subname, "", \%opts, $subtype->[0]); + } + } +} + +sub _generate_method { + my ($caller_pkg, $subname, $array_index, $opts, $type) = @_; + + croak("Cannot use undef as a array index for generating an XS $type accessor. (Sub: $subname)") + if not defined $array_index; + + $subname = "${caller_pkg}::$subname" if $subname !~ /::/; + + Class::XSAccessor::Heavy::check_sub_existence($subname) if not $opts->{replace}; + no warnings 'redefine'; # don't warn about an explicitly requested redefine + + if ($type eq 'getter') { + newxs_getter($subname, $array_index); + } + if ($type eq 'lvalue_accessor') { + newxs_lvalue_accessor($subname, $array_index); + } + elsif ($type eq 'setter') { + newxs_setter($subname, $array_index, $opts->{chained}||0); + } + elsif ($type eq 'predicate') { + newxs_predicate($subname, $array_index); + } + elsif ($type eq 'constructor') { + newxs_constructor($subname); + } + elsif ($type eq 'true') { + Class::XSAccessor::newxs_boolean($subname, 1); + } + elsif ($type eq 'false') { + Class::XSAccessor::newxs_boolean($subname, 0); + } + else { + newxs_accessor($subname, $array_index, $opts->{chained}||0); + } +} + +1; + +__END__ + +=head1 NAME + +Class::XSAccessor::Array - Generate fast XS accessors without runtime compilation + +=head1 SYNOPSIS + + package MyClassUsingArraysAsInternalStorage; + use Class::XSAccessor::Array + constructor => 'new', + getters => { + get_foo => 0, # 0 is the array index to access + get_bar => 1, + }, + setters => { + set_foo => 0, + set_bar => 1, + }, + accessors => { # a mutator + buz => 2, + }, + predicates => { # test for definedness + has_buz => 2, + }, + lvalue_accessors => { # see below + baz => 3, + }, + true => [ 'is_token', 'is_whitespace' ], + false => [ 'significant' ]; + + # The imported methods are implemented in fast XS. + + # normal class code here. + +As of version 1.05, some alternative syntax forms are available: + + package MyClass; + + # Options can be passed as a HASH reference if you prefer it, + # which can also help PerlTidy to flow the statement correctly. + use Class::XSAccessor { + getters => { + get_foo => 0, + get_bar => 1, + }, + }; + +=head1 DESCRIPTION + +The module implements fast XS accessors both for getting at and +setting an object attribute. Additionally, the module supports +mutators and simple predicates (C like tests for definedness +of an attributes). +The module works only with objects +that are implemented as B. Using it on hash-based objects is +bound to make your life miserable. Refer to L for +an implementation that works with hash-based objects. + +A simple benchmark showed a significant performance +advantage over writing accessors in Perl. + +Since version 0.10, the module can also generate simple constructors +(implemented in XS) for you. Simply supply the +C 'constructor_name'> option or the +C ['new', 'create', 'spawn']> option. +These constructors do the equivalent of the following Perl code: + + sub new { + my $class = shift; + return bless [], ref($class)||$class; + } + +That means they can be called on objects and classes but will not +clone objects entirely. Note that any parameters to new() will be +discarded! If there is a better idiom for array-based objects, let +me know. + +While generally more obscure than hash-based objects, +objects using blessed arrays as internal representation +are a bit faster as its somewhat faster to access arrays than hashes. +Accordingly, this module is slightly faster (~10-15%) than +L, which works on hash-based objects. + +The method names may be fully qualified. In the example of the +synopsis, you could have written C instead +of C. This way, you can install methods in classes other +than the current class. See also: The C option below. + +Since version 1.01, you can generate extremely simple methods which +just return true or false (and always do so). If that seems like a +really superfluous thing to you, then think of a large class hierarchy +with interfaces such as PPI. This is implemented as the C +and C options, see synopsis. + +=head1 OPTIONS + +In addition to specifying the types and names of accessors, you can add options +which modify behaviour. The options are specified as key/value pairs just as the +accessor declaration. Example: + + use Class::XSAccessor::Array + getters => { + get_foo => 0, + }, + replace => 1; + +The list of available options is: + +=head2 replace + +Set this to a true value to prevent C from +complaining about replacing existing subroutines. + +=head2 chained + +Set this to a true value to change the return value of setters +and mutators (when called with an argument). +If C is enabled, the setters and accessors/mutators will +return the object. Mutators called without an argument still +return the value of the associated attribute. + +As with the other options, C affects all methods generated +in the same C statement. + +=head2 class + +By default, the accessors are generated in the calling class. Using +the C option, you can explicitly specify where the methods +are to be generated. + +=head1 LVALUES + +Support for lvalue accessors via the keyword C +was added in version 1.08. At this point, B. Furthermore, their performance hasn't been benchmarked +yet. + +The following example demonstrates an lvalue accessor: + + package Address; + use Class::XSAccessor + constructor => 'new', + lvalue_accessors => { zip_code => 0 }; + + package main; + my $address = Address->new(2); + print $address->zip_code, "\n"; # prints 2 + $address->zip_code = 76135; # <--- This is it! + print $address->zip_code, "\n"; # prints 76135 + +=head1 CAVEATS + +Probably wouldn't work if your objects are I. But that's a strange thing to do anyway. + +Scary code exploiting strange XS features. + +If you think writing an accessor in XS should be a laughably simple exercise, then +please contemplate how you could instantiate a new XS accessor for a new hash key +or array index that's only known at run-time. Note that compiling C code at run-time +a la Inline::C is a no go. + +Threading. With version 1.00, a memory leak has been B that would leak a small amount of +memory if you loaded C-based classes in a subthread that hadn't been loaded +in the "main" thread before. If the subthread then terminated, a hash key and an int per +associated method used ot be lost. Note that this mattered only if classes were B loaded +in a sort of throw-away thread. + +In the new implementation as of 1.00, the memory will not be released again either in the above +situation. But it will be recycled when the same class or a similar class is loaded +again in B thread. + +=head1 SEE ALSO + +L + +L + +=head1 AUTHOR + +Steffen Mueller Esmueller@cpan.orgE + +chocolateboy Echocolate@cpan.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 by Steffen Mueller + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8 or, +at your option, any later version of Perl 5 you may have available. + +=cut diff --git a/CPAN/arch/5.42/Class/XSAccessor/Heavy.pm b/CPAN/arch/5.42/Class/XSAccessor/Heavy.pm new file mode 100644 index 00000000000..7b74b145cef --- /dev/null +++ b/CPAN/arch/5.42/Class/XSAccessor/Heavy.pm @@ -0,0 +1,76 @@ +package # hide from PAUSE + Class::XSAccessor::Heavy; + +use 5.008; +use strict; +use warnings; +use Carp; + +our $VERSION = '1.18'; +our @CARP_NOT = qw( + Class::XSAccessor + Class::XSAccessor::Array +); + +# TODO Move more duplicated code from XSA and XSA::Array here + + +sub check_sub_existence { + my $subname = shift; + + my $sub_package = $subname; + $sub_package =~ s/([^:]+)$// or die; + my $bare_subname = $1; + + my $sym; + { + no strict 'refs'; + $sym = \%{"$sub_package"}; + } + no warnings; + local *s = $sym->{$bare_subname}; + my $coderef = *s{CODE}; + if ($coderef) { + $sub_package =~ s/::$//; + Carp::croak("Cannot replace existing subroutine '$bare_subname' in package '$sub_package' with an XS implementation. If you wish to force a replacement, add the 'replace => 1' parameter to the arguments of 'use ".(caller())[0]."'."); + } +} + +1; + +__END__ + +=head1 NAME + +Class::XSAccessor::Heavy - Guts you don't care about + +=head1 SYNOPSIS + + use Class::XSAccessor! + +=head1 DESCRIPTION + +Common guts for Class::XSAccessor and Class::XSAccessor::Array. +No user-serviceable parts inside! + +=head1 SEE ALSO + +L +L + +=head1 AUTHOR + +Steffen Mueller, Esmueller@cpan.orgE + +chocolateboy, Echocolate@cpan.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 by Steffen Mueller + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8 or, +at your option, any later version of Perl 5 you may have available. + +=cut + diff --git a/CPAN/arch/5.42/DBD/DBM.pm b/CPAN/arch/5.42/DBD/DBM.pm new file mode 100644 index 00000000000..a8fe8b9a00c --- /dev/null +++ b/CPAN/arch/5.42/DBD/DBM.pm @@ -0,0 +1,1454 @@ +####################################################################### +# +# DBD::DBM - a DBI driver for DBM files +# +# Copyright (c) 2004 by Jeff Zucker < jzucker AT cpan.org > +# Copyright (c) 2010-2013 by Jens Rehsack & H.Merijn Brand +# +# All rights reserved. +# +# You may freely distribute and/or modify this module under the terms +# of either the GNU General Public License (GPL) or the Artistic License, +# as specified in the Perl README file. +# +# USERS - see the pod at the bottom of this file +# +# DBD AUTHORS - see the comments in the code +# +####################################################################### +require 5.008; +use strict; + +################# +package DBD::DBM; +################# +use base qw( DBD::File ); +use vars qw($VERSION $ATTRIBUTION $drh $methods_already_installed); +$VERSION = '0.08'; +$ATTRIBUTION = 'DBD::DBM by Jens Rehsack'; + +# no need to have driver() unless you need private methods +# +sub driver ($;$) +{ + my ( $class, $attr ) = @_; + return $drh if ($drh); + + # do the real work in DBD::File + # + $attr->{Attribution} = 'DBD::DBM by Jens Rehsack'; + $drh = $class->SUPER::driver($attr); + + # install private methods + # + # this requires that dbm_ (or foo_) be a registered prefix + # but you can write private methods before official registration + # by hacking the $dbd_prefix_registry in a private copy of DBI.pm + # + unless ( $methods_already_installed++ ) + { + DBD::DBM::st->install_method('dbm_schema'); + } + + return $drh; +} + +sub CLONE +{ + undef $drh; +} + +##################### +package DBD::DBM::dr; +##################### +$DBD::DBM::dr::imp_data_size = 0; +@DBD::DBM::dr::ISA = qw(DBD::File::dr); + +# you could put some :dr private methods here + +# you may need to over-ride some DBD::File::dr methods here +# but you can probably get away with just letting it do the work +# in most cases + +##################### +package DBD::DBM::db; +##################### +$DBD::DBM::db::imp_data_size = 0; +@DBD::DBM::db::ISA = qw(DBD::File::db); + +use Carp qw/carp/; + +sub validate_STORE_attr +{ + my ( $dbh, $attrib, $value ) = @_; + + if ( $attrib eq "dbm_ext" or $attrib eq "dbm_lockfile" ) + { + ( my $newattrib = $attrib ) =~ s/^dbm_/f_/g; + carp "Attribute '$attrib' is depreciated, use '$newattrib' instead" if ($^W); + $attrib = $newattrib; + } + + return $dbh->SUPER::validate_STORE_attr( $attrib, $value ); +} + +sub validate_FETCH_attr +{ + my ( $dbh, $attrib ) = @_; + + if ( $attrib eq "dbm_ext" or $attrib eq "dbm_lockfile" ) + { + ( my $newattrib = $attrib ) =~ s/^dbm_/f_/g; + carp "Attribute '$attrib' is depreciated, use '$newattrib' instead" if ($^W); + $attrib = $newattrib; + } + + return $dbh->SUPER::validate_FETCH_attr($attrib); +} + +sub set_versions +{ + my $this = $_[0]; + $this->{dbm_version} = $DBD::DBM::VERSION; + return $this->SUPER::set_versions(); +} + +sub init_valid_attributes +{ + my $dbh = shift; + + # define valid private attributes + # + # attempts to set non-valid attrs in connect() or + # with $dbh->{attr} will throw errors + # + # the attrs here *must* start with dbm_ or foo_ + # + # see the STORE methods below for how to check these attrs + # + $dbh->{dbm_valid_attrs} = { + dbm_type => 1, # the global DBM type e.g. SDBM_File + dbm_mldbm => 1, # the global MLDBM serializer + dbm_cols => 1, # the global column names + dbm_version => 1, # verbose DBD::DBM version + dbm_store_metadata => 1, # column names, etc. + dbm_berkeley_flags => 1, # for BerkeleyDB + dbm_valid_attrs => 1, # DBD::DBM::db valid attrs + dbm_readonly_attrs => 1, # DBD::DBM::db r/o attrs + dbm_meta => 1, # DBD::DBM public access for f_meta + dbm_tables => 1, # DBD::DBM public access for f_meta + }; + $dbh->{dbm_readonly_attrs} = { + dbm_version => 1, # verbose DBD::DBM version + dbm_valid_attrs => 1, # DBD::DBM::db valid attrs + dbm_readonly_attrs => 1, # DBD::DBM::db r/o attrs + dbm_meta => 1, # DBD::DBM public access for f_meta + }; + + $dbh->{dbm_meta} = "dbm_tables"; + + return $dbh->SUPER::init_valid_attributes(); +} + +sub init_default_attributes +{ + my ( $dbh, $phase ) = @_; + + $dbh->SUPER::init_default_attributes($phase); + $dbh->{f_lockfile} = '.lck'; + + return $dbh; +} + +sub get_dbm_versions +{ + my ( $dbh, $table ) = @_; + $table ||= ''; + + my $meta; + my $class = $dbh->{ImplementorClass}; + $class =~ s/::db$/::Table/; + $table and ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 ); + $meta or ( $meta = {} and $class->bootstrap_table_meta( $dbh, $meta, $table ) ); + + my $dver; + my $dtype = $meta->{dbm_type}; + eval { + $dver = $meta->{dbm_type}->VERSION(); + + # *) when we're still alive here, everything went ok - no need to check for $@ + $dtype .= " ($dver)"; + }; + if ( $meta->{dbm_mldbm} ) + { + $dtype .= ' + MLDBM'; + eval { + $dver = MLDBM->VERSION(); + $dtype .= " ($dver)"; # (*) + }; + eval { + my $ser_class = "MLDBM::Serializer::" . $meta->{dbm_mldbm}; + my $ser_mod = $ser_class; + $ser_mod =~ s|::|/|g; + $ser_mod .= ".pm"; + require $ser_mod; + $dver = $ser_class->VERSION(); + $dtype .= ' + ' . $ser_class; # (*) + $dver and $dtype .= " ($dver)"; # (*) + }; + } + return sprintf( "%s using %s", $dbh->{dbm_version}, $dtype ); +} + +# you may need to over-ride some DBD::File::db methods here +# but you can probably get away with just letting it do the work +# in most cases + +##################### +package DBD::DBM::st; +##################### +$DBD::DBM::st::imp_data_size = 0; +@DBD::DBM::st::ISA = qw(DBD::File::st); + +sub FETCH +{ + my ( $sth, $attr ) = @_; + + if ( $attr eq "NULLABLE" ) + { + my @colnames = $sth->sql_get_colnames(); + + # XXX only BerkeleyDB fails having NULL values for non-MLDBM databases, + # none accept it for key - but it requires more knowledge between + # queries and tables storage to return fully correct information + $attr eq "NULLABLE" and return [ map { 0 } @colnames ]; + } + + return $sth->SUPER::FETCH($attr); +} # FETCH + +sub dbm_schema +{ + my ( $sth, $tname ) = @_; + return $sth->set_err( $DBI::stderr, 'No table name supplied!' ) unless $tname; + my $tbl_meta = $sth->{Database}->func( $tname, "f_schema", "get_sql_engine_meta" ) + or return $sth->set_err( $sth->{Database}->err(), $sth->{Database}->errstr() ); + return $tbl_meta->{$tname}->{f_schema}; +} +# you could put some :st private methods here + +# you may need to over-ride some DBD::File::st methods here +# but you can probably get away with just letting it do the work +# in most cases + +############################ +package DBD::DBM::Statement; +############################ + +@DBD::DBM::Statement::ISA = qw(DBD::File::Statement); + +######################## +package DBD::DBM::Table; +######################## +use Carp; +use Fcntl; + +@DBD::DBM::Table::ISA = qw(DBD::File::Table); + +my $dirfext = $^O eq 'VMS' ? '.sdbm_dir' : '.dir'; + +my %reset_on_modify = ( + dbm_type => "dbm_tietype", + dbm_mldbm => "dbm_tietype", + ); +__PACKAGE__->register_reset_on_modify( \%reset_on_modify ); + +my %compat_map = ( + ( map { $_ => "dbm_$_" } qw(type mldbm store_metadata) ), + dbm_ext => 'f_ext', + dbm_file => 'f_file', + dbm_lockfile => ' f_lockfile', + ); +__PACKAGE__->register_compat_map( \%compat_map ); + +sub bootstrap_table_meta +{ + my ( $self, $dbh, $meta, $table ) = @_; + + $meta->{dbm_type} ||= $dbh->{dbm_type} || 'SDBM_File'; + $meta->{dbm_mldbm} ||= $dbh->{dbm_mldbm} if ( $dbh->{dbm_mldbm} ); + $meta->{dbm_berkeley_flags} ||= $dbh->{dbm_berkeley_flags}; + + defined $meta->{f_ext} + or $meta->{f_ext} = $dbh->{f_ext}; + unless ( defined( $meta->{f_ext} ) ) + { + my $ext; + if ( $meta->{dbm_type} eq 'SDBM_File' or $meta->{dbm_type} eq 'ODBM_File' ) + { + $ext = '.pag/r'; + } + elsif ( $meta->{dbm_type} eq 'NDBM_File' ) + { + # XXX NDBM_File on FreeBSD (and elsewhere?) may actually be Berkeley + # behind the scenes and so create a single .db file. + if ( $^O =~ /bsd/i or lc($^O) eq 'darwin' ) + { + $ext = '.db/r'; + } + elsif ( $^O eq 'SunOS' or $^O eq 'Solaris' or $^O eq 'AIX' ) + { + $ext = '.pag/r'; # here it's implemented like dbm - just a bit improved + } + # else wrapped GDBM + } + defined($ext) and $meta->{f_ext} = $ext; + } + + $self->SUPER::bootstrap_table_meta( $dbh, $meta, $table ); +} + +sub init_table_meta +{ + my ( $self, $dbh, $meta, $table ) = @_; + + $meta->{f_dontopen} = 1; + + unless ( defined( $meta->{dbm_tietype} ) ) + { + my $tie_type = $meta->{dbm_type}; + $INC{"$tie_type.pm"} or require "$tie_type.pm"; + $tie_type eq 'BerkeleyDB' and $tie_type = 'BerkeleyDB::Hash'; + + if ( $meta->{dbm_mldbm} ) + { + $INC{"MLDBM.pm"} or require "MLDBM.pm"; + $meta->{dbm_usedb} = $tie_type; + $tie_type = 'MLDBM'; + } + + $meta->{dbm_tietype} = $tie_type; + } + + unless ( defined( $meta->{dbm_store_metadata} ) ) + { + my $store = $dbh->{dbm_store_metadata}; + defined($store) or $store = 1; + $meta->{dbm_store_metadata} = $store; + } + + unless ( defined( $meta->{col_names} ) ) + { + defined( $dbh->{dbm_cols} ) and $meta->{col_names} = $dbh->{dbm_cols}; + } + + $self->SUPER::init_table_meta( $dbh, $meta, $table ); +} + +sub open_data +{ + my ( $className, $meta, $attrs, $flags ) = @_; + $className->SUPER::open_data( $meta, $attrs, $flags ); + + unless ( $flags->{dropMode} ) + { + # TIEING + # + # XXX allow users to pass in a pre-created tied object + # + my @tie_args; + if ( $meta->{dbm_type} eq 'BerkeleyDB' ) + { + my $DB_CREATE = BerkeleyDB::DB_CREATE(); + my $DB_RDONLY = BerkeleyDB::DB_RDONLY(); + my %tie_flags; + if ( my $f = $meta->{dbm_berkeley_flags} ) + { + defined( $f->{DB_CREATE} ) and $DB_CREATE = delete $f->{DB_CREATE}; + defined( $f->{DB_RDONLY} ) and $DB_RDONLY = delete $f->{DB_RDONLY}; + %tie_flags = %$f; + } + my $open_mode = $flags->{lockMode} || $flags->{createMode} ? $DB_CREATE : $DB_RDONLY; + @tie_args = ( + -Filename => $meta->{f_fqbn}, + -Flags => $open_mode, + %tie_flags + ); + } + else + { + my $open_mode = O_RDONLY; + $flags->{lockMode} and $open_mode = O_RDWR; + $flags->{createMode} and $open_mode = O_RDWR | O_CREAT | O_TRUNC; + + @tie_args = ( $meta->{f_fqbn}, $open_mode, 0666 ); + } + + if ( $meta->{dbm_mldbm} ) + { + $MLDBM::UseDB = $meta->{dbm_usedb}; + $MLDBM::Serializer = $meta->{dbm_mldbm}; + } + + $meta->{hash} = {}; + my $tie_class = $meta->{dbm_tietype}; + eval { tie %{ $meta->{hash} }, $tie_class, @tie_args }; + $@ and croak "Cannot tie(\%h $tie_class @tie_args): $@"; + -f $meta->{f_fqfn} or croak( "No such file: '" . $meta->{f_fqfn} . "'" ); + } + + unless ( $flags->{createMode} ) + { + my ( $meta_data, $schema, $col_names ); + if ( $meta->{dbm_store_metadata} ) + { + $meta_data = $col_names = $meta->{hash}->{"_metadata \0"}; + if ( $meta_data and $meta_data =~ m~(.+)~is ) + { + $schema = $col_names = $1; + $schema =~ s~.*(.+).*~$1~is; + $col_names =~ s~.*(.+).*~$1~is; + } + } + $col_names ||= $meta->{col_names} || [ 'k', 'v' ]; + $col_names = [ split /,/, $col_names ] if ( ref $col_names ne 'ARRAY' ); + if ( $meta->{dbm_store_metadata} and not $meta->{hash}->{"_metadata \0"} ) + { + $schema or $schema = ''; + $meta->{hash}->{"_metadata \0"} = + "" + . "$schema" + . "" + . join( ",", @{$col_names} ) + . "" + . ""; + } + + $meta->{schema} = $schema; + $meta->{col_names} = $col_names; + } +} + +# you must define drop +# it is called from execute of a SQL DROP statement +# +sub drop ($$) +{ + my ( $self, $data ) = @_; + my $meta = $self->{meta}; + $meta->{hash} and untie %{ $meta->{hash} }; + $self->SUPER::drop($data); + # XXX extra_files + -f $meta->{f_fqbn} . $dirfext + and $meta->{f_ext} eq '.pag/r' + and unlink( $meta->{f_fqbn} . $dirfext ); + return 1; +} + +# you must define fetch_row, it is called on all fetches; +# it MUST return undef when no rows are left to fetch; +# checking for $ary[0] is specific to hashes so you'll +# probably need some other kind of check for nothing-left. +# as Janis might say: "undef's just another word for +# nothing left to fetch" :-) +# +sub fetch_row ($$) +{ + my ( $self, $data ) = @_; + my $meta = $self->{meta}; + # fetch with %each + # + my @ary = each %{ $meta->{hash} }; + $meta->{dbm_store_metadata} + and $ary[0] + and $ary[0] eq "_metadata \0" + and @ary = each %{ $meta->{hash} }; + + my ( $key, $val ) = @ary; + unless ($key) + { + delete $self->{row}; + return; + } + my @row = ( ref($val) eq 'ARRAY' ) ? ( $key, @$val ) : ( $key, $val ); + $self->{row} = @row ? \@row : undef; + return wantarray ? @row : \@row; +} + +# you must define push_row except insert_new_row and update_specific_row is defined +# it is called on inserts and updates as primitive +# +sub insert_new_row ($$$) +{ + my ( $self, $data, $row_aryref ) = @_; + my $meta = $self->{meta}; + my $ncols = scalar( @{ $meta->{col_names} } ); + my $nitems = scalar( @{$row_aryref} ); + $ncols == $nitems + or croak "You tried to insert $nitems, but table is created with $ncols columns"; + + my $key = shift @$row_aryref; + my $exists; + eval { $exists = exists( $meta->{hash}->{$key} ); }; + $exists and croak "Row with PK '$key' already exists"; + + $meta->{hash}->{$key} = $meta->{dbm_mldbm} ? $row_aryref : $row_aryref->[0]; + + return 1; +} + +# this is where you grab the column names from a CREATE statement +# if you don't need to do that, it must be defined but can be empty +# +sub push_names ($$$) +{ + my ( $self, $data, $row_aryref ) = @_; + my $meta = $self->{meta}; + + # some sanity checks ... + my $ncols = scalar(@$row_aryref); + $ncols < 2 and croak "At least 2 columns are required for DBD::DBM tables ..."; + !$meta->{dbm_mldbm} + and $ncols > 2 + and croak "Without serializing with MLDBM only 2 columns are supported, you give $ncols"; + $meta->{col_names} = $row_aryref; + return unless $meta->{dbm_store_metadata}; + + my $stmt = $data->{sql_stmt}; + my $col_names = join( ',', @{$row_aryref} ); + my $schema = $data->{Database}->{Statement}; + $schema =~ s/^[^\(]+\((.+)\)$/$1/s; + $schema = $stmt->schema_str() if ( $stmt->can('schema_str') ); + $meta->{hash}->{"_metadata \0"} = + "" + . "$schema" + . "$col_names" + . ""; +} + +# fetch_one_row, delete_one_row, update_one_row +# are optimized for hash-style lookup without looping; +# if you don't need them, omit them, they're optional +# but, in that case you may need to define +# truncate() and seek(), see below +# +sub fetch_one_row ($$;$) +{ + my ( $self, $key_only, $key ) = @_; + my $meta = $self->{meta}; + $key_only and return $meta->{col_names}->[0]; + exists $meta->{hash}->{$key} or return; + my $val = $meta->{hash}->{$key}; + $val = ( ref($val) eq 'ARRAY' ) ? $val : [$val]; + my $row = [ $key, @$val ]; + return wantarray ? @{$row} : $row; +} + +sub delete_one_row ($$$) +{ + my ( $self, $data, $aryref ) = @_; + my $meta = $self->{meta}; + delete $meta->{hash}->{ $aryref->[0] }; +} + +sub update_one_row ($$$) +{ + my ( $self, $data, $aryref ) = @_; + my $meta = $self->{meta}; + my $key = shift @$aryref; + defined $key or return; + my $row = ( ref($aryref) eq 'ARRAY' ) ? $aryref : [$aryref]; + $meta->{hash}->{$key} = $meta->{dbm_mldbm} ? $row : $row->[0]; +} + +sub update_specific_row ($$$$) +{ + my ( $self, $data, $aryref, $origary ) = @_; + my $meta = $self->{meta}; + my $key = shift @$origary; + my $newkey = shift @$aryref; + return unless ( defined $key ); + $key eq $newkey or delete $meta->{hash}->{$key}; + my $row = ( ref($aryref) eq 'ARRAY' ) ? $aryref : [$aryref]; + $meta->{hash}->{$newkey} = $meta->{dbm_mldbm} ? $row : $row->[0]; +} + +# you may not need to explicitly DESTROY the ::Table +# put cleanup code to run when the execute is done +# +sub DESTROY ($) +{ + my $self = shift; + my $meta = $self->{meta}; + $meta->{hash} and untie %{ $meta->{hash} }; + + $self->SUPER::DESTROY(); +} + +# truncate() and seek() must be defined to satisfy DBI::SQL::Nano +# *IF* you define the *_one_row methods above, truncate() and +# seek() can be empty or you can use them without actually +# truncating or seeking anything but if you don't define the +# *_one_row methods, you may need to define these + +# if you need to do something after a series of +# deletes or updates, you can put it in truncate() +# which is called at the end of executing +# +sub truncate ($$) +{ + # my ( $self, $data ) = @_; + return 1; +} + +# seek() is only needed if you use IO::File +# though it could be used for other non-file operations +# that you need to do before "writes" or truncate() +# +sub seek ($$$$) +{ + # my ( $self, $data, $pos, $whence ) = @_; + return 1; +} + +# Th, th, th, that's all folks! See DBD::File and DBD::CSV for other +# examples of creating pure perl DBDs. I hope this helped. +# Now it's time to go forth and create your own DBD! +# Remember to check in with dbi-dev@perl.org before you get too far. +# We may be able to make suggestions or point you to other related +# projects. + +1; +__END__ + +=pod + +=head1 NAME + +DBD::DBM - a DBI driver for DBM & MLDBM files + +=head1 SYNOPSIS + + use DBI; + $dbh = DBI->connect('dbi:DBM:'); # defaults to SDBM_File + $dbh = DBI->connect('DBI:DBM(RaiseError=1):'); # defaults to SDBM_File + $dbh = DBI->connect('dbi:DBM:dbm_type=DB_File'); # defaults to DB_File + $dbh = DBI->connect('dbi:DBM:dbm_mldbm=Storable'); # MLDBM with SDBM_File + + # or + $dbh = DBI->connect('dbi:DBM:', undef, undef); + $dbh = DBI->connect('dbi:DBM:', undef, undef, { + f_ext => '.db/r', + f_dir => '/path/to/dbfiles/', + f_lockfile => '.lck', + dbm_type => 'BerkeleyDB', + dbm_mldbm => 'FreezeThaw', + dbm_store_metadata => 1, + dbm_berkeley_flags => { + '-Cachesize' => 1000, # set a ::Hash flag + }, + }); + +and other variations on connect() as shown in the L docs, +L and L +shown below. + +Use standard DBI prepare, execute, fetch, placeholders, etc., +see L for an example. + +=head1 DESCRIPTION + +DBD::DBM is a database management system that works right out of the +box. If you have a standard installation of Perl and DBI you can +begin creating, accessing, and modifying simple database tables +without any further modules. You can add other modules (e.g., +SQL::Statement, DB_File etc) for improved functionality. + +The module uses a DBM file storage layer. DBM file storage is common on +many platforms and files can be created with it in many programming +languages using different APIs. That means, in addition to creating +files with DBI/SQL, you can also use DBI/SQL to access and modify files +created by other DBM modules and programs and vice versa. B that +in those cases it might be necessary to use a common subset of the +provided features. + +DBM files are stored in binary format optimized for quick retrieval +when using a key field. That optimization can be used advantageously +to make DBD::DBM SQL operations that use key fields very fast. There +are several different "flavors" of DBM which use different storage +formats supported by perl modules such as SDBM_File and MLDBM. This +module supports all of the flavors that perl supports and, when used +with MLDBM, supports tables with any number of columns and insertion +of Perl objects into tables. + +DBD::DBM has been tested with the following DBM types: SDBM_File, +NDBM_File, ODBM_File, GDBM_File, DB_File, BerkeleyDB. Each type was +tested both with and without MLDBM and with the Data::Dumper, +Storable, FreezeThaw, YAML and JSON serializers using the DBI::SQL::Nano +or the SQL::Statement engines. + +=head1 QUICK START + +DBD::DBM operates like all other DBD drivers - it's basic syntax and +operation is specified by DBI. If you're not familiar with DBI, you should +start by reading L and the documents it points to and then come back +and read this file. If you are familiar with DBI, you already know most of +what you need to know to operate this module. Just jump in and create a +test script something like the one shown below. + +You should be aware that there are several options for the SQL engine +underlying DBD::DBM, see L. There are also many +options for DBM support, see especially the section on L. + +But here's a sample to get you started. + + use DBI; + my $dbh = DBI->connect('dbi:DBM:'); + $dbh->{RaiseError} = 1; + for my $sql( split /;\n+/," + CREATE TABLE user ( user_name TEXT, phone TEXT ); + INSERT INTO user VALUES ('Fred Bloggs','233-7777'); + INSERT INTO user VALUES ('Sanjay Patel','777-3333'); + INSERT INTO user VALUES ('Junk','xxx-xxxx'); + DELETE FROM user WHERE user_name = 'Junk'; + UPDATE user SET phone = '999-4444' WHERE user_name = 'Sanjay Patel'; + SELECT * FROM user + "){ + my $sth = $dbh->prepare($sql); + $sth->execute; + $sth->dump_results if $sth->{NUM_OF_FIELDS}; + } + $dbh->disconnect; + +=head1 USAGE + +This section will explain some usage cases in more detail. To get an +overview about the available attributes, see L. + +=head2 Specifying Files and Directories + +DBD::DBM will automatically supply an appropriate file extension for the +type of DBM you are using. For example, if you use SDBM_File, a table +called "fruit" will be stored in two files called "fruit.pag" and +"fruit.dir". You should B specify the file extensions in your SQL +statements. + +DBD::DBM recognizes following default extensions for following types: + +=over 4 + +=item .pag/r + +Chosen for dbm_type C<< SDBM_File >>, C<< ODBM_File >> and C<< NDBM_File >> +when an implementation is detected which wraps C<< -ldbm >> for +C<< NDBM_File >> (e.g. Solaris, AIX, ...). + +For those types, the C<< .dir >> extension is recognized, too (for being +deleted when dropping a table). + +=item .db/r + +Chosen for dbm_type C<< NDBM_File >> when an implementation is detected +which wraps BerkeleyDB 1.x for C<< NDBM_File >> (typically BSD's, Darwin). + +=back + +C<< GDBM_File >>, C<< DB_File >> and C<< BerkeleyDB >> don't usually +use a file extension. + +If your DBM type uses an extension other than one of the recognized +types of extensions, you should set the I attribute to the +extension B file a bug report as described in DBI with the name +of the implementation and extension so we can add it to DBD::DBM. +Thanks in advance for that :-). + + $dbh = DBI->connect('dbi:DBM:f_ext=.db'); # .db extension is used + $dbh = DBI->connect('dbi:DBM:f_ext='); # no extension is used + + # or + $dbh->{f_ext}='.db'; # global setting + $dbh->{f_meta}->{'qux'}->{f_ext}='.db'; # setting for table 'qux' + +By default files are assumed to be in the current working directory. +To use other directories specify the I attribute in either the +connect string or by setting the database handle attribute. + +For example, this will look for the file /foo/bar/fruit (or +/foo/bar/fruit.pag for DBM types that use that extension) + + my $dbh = DBI->connect('dbi:DBM:f_dir=/foo/bar'); + # and this will too: + my $dbh = DBI->connect('dbi:DBM:'); + $dbh->{f_dir} = '/foo/bar'; + # but this is recommended + my $dbh = DBI->connect('dbi:DBM:', undef, undef, { f_dir => '/foo/bar' } ); + + # now you can do + my $ary = $dbh->selectall_arrayref(q{ SELECT x FROM fruit }); + +You can also use delimited identifiers to specify paths directly in SQL +statements. This looks in the same place as the two examples above but +without setting I: + + my $dbh = DBI->connect('dbi:DBM:'); + my $ary = $dbh->selectall_arrayref(q{ + SELECT x FROM "/foo/bar/fruit" + }); + +You can also tell DBD::DBM to use a specified path for a specific table: + + $dbh->{dbm_tables}->{f}->{file} = q(/foo/bar/fruit); + +Please be aware that you cannot specify this during connection. + +If you have SQL::Statement installed, you can use table aliases: + + my $dbh = DBI->connect('dbi:DBM:'); + my $ary = $dbh->selectall_arrayref(q{ + SELECT f.x FROM "/foo/bar/fruit" AS f + }); + +See the L for using DROP on tables. + +=head2 Table locking and flock() + +Table locking is accomplished using a lockfile which has the same +basename as the table's file but with the file extension '.lck' (or a +lockfile extension that you supply, see below). This lock file is +created with the table during a CREATE and removed during a DROP. +Every time the table itself is opened, the lockfile is flocked(). For +SELECT, this is a shared lock. For all other operations, it is an +exclusive lock (except when you specify something different using the +I attribute). + +Since the locking depends on flock(), it only works on operating +systems that support flock(). In cases where flock() is not +implemented, DBD::DBM will simply behave as if the flock() had +occurred although no actual locking will happen. Read the +documentation for flock() for more information. + +Even on those systems that do support flock(), locking is only +advisory - as is always the case with flock(). This means that if +another program tries to access the table file while DBD::DBM has the +table locked, that other program will *succeed* at opening unless +it is also using flock on the '.lck' file. As a result DBD::DBM's +locking only really applies to other programs using DBD::DBM or other +program written to cooperate with DBD::DBM locking. + +=head2 Specifying the DBM type + +Each "flavor" of DBM stores its files in a different format and has +different capabilities and limitations. See L for a +comparison of DBM types. + +By default, DBD::DBM uses the C<< SDBM_File >> type of storage since +C<< SDBM_File >> comes with Perl itself. If you have other types of +DBM storage available, you can use any of them with DBD::DBM. It is +strongly recommended to use at least C<< DB_File >>, because C<< +SDBM_File >> has quirks and limitations and C<< ODBM_file >>, C<< +NDBM_File >> and C<< GDBM_File >> are not always available. + +You can specify the DBM type using the I attribute which can +be set in the connection string or with C<< $dbh->{dbm_type} >> and +C<< $dbh->{f_meta}->{$table_name}->{type} >> for per-table settings in +cases where a single script is accessing more than one kind of DBM +file. + +In the connection string, just set C<< dbm_type=TYPENAME >> where +C<< TYPENAME >> is any DBM type such as GDBM_File, DB_File, etc. Do I +use MLDBM as your I as that is set differently, see below. + + my $dbh=DBI->connect('dbi:DBM:'); # uses the default SDBM_File + my $dbh=DBI->connect('dbi:DBM:dbm_type=GDBM_File'); # uses the GDBM_File + + # You can also use $dbh->{dbm_type} to set the DBM type for the connection: + $dbh->{dbm_type} = 'DB_File'; # set the global DBM type + print $dbh->{dbm_type}; # display the global DBM type + +If you have several tables in your script that use different DBM +types, you can use the $dbh->{dbm_tables} hash to store different +settings for the various tables. You can even use this to perform +joins on files that have completely different storage mechanisms. + + # sets global default of GDBM_File + my $dbh->('dbi:DBM:type=GDBM_File'); + + # overrides the global setting, but only for the tables called + # I and I + my $dbh->{f_meta}->{foo}->{dbm_type} = 'DB_File'; + my $dbh->{f_meta}->{bar}->{dbm_type} = 'BerkeleyDB'; + + # prints the dbm_type for the table "foo" + print $dbh->{f_meta}->{foo}->{dbm_type}; + +B that you must change the I of a table before you access +it for first time. + +=head2 Adding multi-column support with MLDBM + +Most of the DBM types only support two columns and even if it would +support more, DBD::DBM would only use two. However a CPAN module +called MLDBM overcomes this limitation by allowing more than two +columns. MLDBM does this by serializing the data - basically it puts +a reference to an array into the second column. It can also put almost +any kind of Perl object or even B into columns. + +If you want more than two columns, you B install MLDBM. It's available +for many platforms and is easy to install. + +MLDBM is by default distributed with three serializers - Data::Dumper, +Storable, and FreezeThaw. Data::Dumper is the default and Storable is the +fastest. MLDBM can also make use of user-defined serialization methods or +other serialization modules (e.g. L or +L. You select the serializer using the +I attribute. + +Some examples: + + $dbh=DBI->connect('dbi:DBM:dbm_mldbm=Storable'); # use MLDBM with Storable + $dbh=DBI->connect( + 'dbi:DBM:dbm_mldbm=MySerializer' # use MLDBM with a user defined module + ); + $dbh=DBI->connect('dbi::dbm:', undef, + undef, { dbm_mldbm => 'YAML' }); # use 3rd party serializer + $dbh->{dbm_mldbm} = 'YAML'; # same as above + print $dbh->{dbm_mldbm} # show the MLDBM serializer + $dbh->{f_meta}->{foo}->{dbm_mldbm}='Data::Dumper'; # set Data::Dumper for table "foo" + print $dbh->{f_meta}->{foo}->{mldbm}; # show serializer for table "foo" + +MLDBM works on top of other DBM modules so you can also set a DBM type +along with setting dbm_mldbm. The examples above would default to using +SDBM_File with MLDBM. If you wanted GDBM_File instead, here's how: + + # uses DB_File with MLDBM and Storable + $dbh = DBI->connect('dbi:DBM:', undef, undef, { + dbm_type => 'DB_File', + dbm_mldbm => 'Storable', + }); + +SDBM_File, the default I is quite limited, so if you are going to +use MLDBM, you should probably use a different type, see L. + +See below for some L about MLDBM. + +=head2 Support for Berkeley DB + +The Berkeley DB storage type is supported through two different Perl +modules - DB_File (which supports only features in old versions of Berkeley +DB) and BerkeleyDB (which supports all versions). DBD::DBM supports +specifying either "DB_File" or "BerkeleyDB" as a I, with or +without MLDBM support. + +The "BerkeleyDB" dbm_type is experimental and it's interface is likely to +change. It currently defaults to BerkeleyDB::Hash and does not currently +support ::Btree or ::Recno. + +With BerkeleyDB, you can specify initialization flags by setting them in +your script like this: + + use BerkeleyDB; + my $env = new BerkeleyDB::Env -Home => $dir; # and/or other Env flags + $dbh = DBI->connect('dbi:DBM:', undef, undef, { + dbm_type => 'BerkeleyDB', + dbm_mldbm => 'Storable', + dbm_berkeley_flags => { + 'DB_CREATE' => DB_CREATE, # pass in constants + 'DB_RDONLY' => DB_RDONLY, # pass in constants + '-Cachesize' => 1000, # set a ::Hash flag + '-Env' => $env, # pass in an environment + }, + }); + +Do I set the -Flags or -Filename flags as those are determined and +overwritten by the SQL (e.g. -Flags => DB_RDONLY is set automatically +when you issue a SELECT statement). + +Time has not permitted us to provide support in this release of DBD::DBM +for further Berkeley DB features such as transactions, concurrency, +locking, etc. We will be working on these in the future and would value +suggestions, patches, etc. + +See L and L for further details. + +=head2 Optimizing the use of key fields + +Most "flavors" of DBM have only two physical columns (but can contain +multiple logical columns as explained above in +L). They work similarly to a +Perl hash with the first column serving as the key. Like a Perl hash, DBM +files permit you to do quick lookups by specifying the key and thus avoid +looping through all records (supported by DBI::SQL::Nano only). Also like +a Perl hash, the keys must be unique. It is impossible to create two +records with the same key. To put this more simply and in SQL terms, +the key column functions as the I or UNIQUE INDEX. + +In DBD::DBM, you can take advantage of the speed of keyed lookups by using +DBI::SQL::Nano and a WHERE clause with a single equal comparison on the key +field. For example, the following SQL statements are optimized for keyed +lookup: + + CREATE TABLE user ( user_name TEXT, phone TEXT); + INSERT INTO user VALUES ('Fred Bloggs','233-7777'); + # ... many more inserts + SELECT phone FROM user WHERE user_name='Fred Bloggs'; + +The "user_name" column is the key column since it is the first +column. The SELECT statement uses the key column in a single equal +comparison - "user_name='Fred Bloggs'" - so the search will find it +very quickly without having to loop through all the names which were +inserted into the table. + +In contrast, these searches on the same table are not optimized: + + 1. SELECT phone FROM user WHERE user_name < 'Fred'; + 2. SELECT user_name FROM user WHERE phone = '233-7777'; + +In #1, the operation uses a less-than (<) comparison rather than an equals +comparison, so it will not be optimized for key searching. In #2, the key +field "user_name" is not specified in the WHERE clause, and therefore the +search will need to loop through all rows to find the requested row(s). + +B that the underlying DBM storage needs to loop over all I +pairs when the optimized fetch is used. SQL::Statement has a massively +improved where clause evaluation which costs around 15% of the evaluation +in DBI::SQL::Nano - combined with the loop in the DBM storage the speed +improvement isn't so impressive. + +Even if lookups are faster by around 50%, DBI::SQL::Nano and +SQL::Statement can benefit from the key field optimizations on +updating and deleting rows - and here the improved where clause +evaluation of SQL::Statement might beat DBI::SQL::Nano every time the +where clause contains not only the key field (or more than one). + +=head2 Supported SQL syntax + +DBD::DBM uses a subset of SQL. The robustness of that subset depends on +what other modules you have installed. Both options support basic SQL +operations including CREATE TABLE, DROP TABLE, INSERT, DELETE, UPDATE, and +SELECT. + +B