123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329 |
- #------------------------------------------------------------------------------
- # File: Import.pm
- #
- # Description: Import CSV and JSON database files
- #
- # Revisions: 2011-03-05 - P. Harvey Created
- #------------------------------------------------------------------------------
- package Image::ExifTool::Import;
- use strict;
- require Exporter;
- use vars qw($VERSION @ISA @EXPORT_OK);
- $VERSION = '1.05';
- @ISA = qw(Exporter);
- @EXPORT_OK = qw(ReadCSV ReadJSON);
- sub ReadJSONObject($;$);
- my %unescapeJSON = ( 't'=>"\t", 'n'=>"\n", 'r'=>"\r" );
- my $charset;
- #------------------------------------------------------------------------------
- # Read CSV file
- # Inputs: 0) CSV file name or file ref, 1) database hash ref, 2) missing tag value
- # Returns: undef on success, or error string
- # Notes: There are various flavours of CSV, but here we assume that only
- # double quotes are escaped, and they are escaped by doubling them
- sub ReadCSV($$;$)
- {
- local ($_, $/);
- my ($file, $database, $missingValue) = @_;
- my ($buff, @tags, $found, $err, $raf, $openedFile);
- if (ref $file eq 'GLOB') {
- $raf = new File::RandomAccess($file);
- $file = 'CSV file';
- } else {
- open CSVFILE, $file or return "Error opening CSV file '$file'";
- binmode CSVFILE;
- $openedFile = 1;
- $raf = new File::RandomAccess(\*CSVFILE);
- }
- # set input record separator by first newline found in the file
- # (safe because first line should contain only tag names)
- while ($raf->Read($buff, 65536)) {
- $buff =~ /(\x0d\x0a|\x0d|\x0a)/ and $/ = $1, last;
- }
- $raf->Seek(0,0);
- while ($raf->ReadLine($buff)) {
- my (@vals, $v, $i, %fileInfo);
- my @toks = split ',', $buff;
- while (@toks) {
- ($v = shift @toks) =~ s/^ +//; # remove leading spaces
- if ($v =~ s/^"//) {
- # quoted value must end in an odd number of quotes
- while ($v !~ /("+)\s*$/ or not length($1) & 1) {
- if (@toks) {
- $v .= ',' . shift @toks;
- } else {
- # read another line from the file
- $raf->ReadLine($buff) or last;
- @toks = split ',', $buff;
- last unless @toks;
- $v .= shift @toks;
- }
- }
- $v =~ s/"\s*$//; # remove trailing quote and whitespace
- $v =~ s/""/"/g; # un-escape quotes
- } else {
- $v =~ s/[ \n\r]+$//;# remove trailing spaces/newlines
- }
- push @vals, $v;
- }
- if (@tags) {
- # save values for each tag
- for ($i=0; $i<@vals and $i<@tags; ++$i) {
- next unless length $vals[$i]; # ignore empty entries
- # delete tag (set value to undef) if value is same as missing tag
- $fileInfo{$tags[$i]} =
- (defined $missingValue and $vals[$i] eq $missingValue) ? undef : $vals[$i];
- }
- # figure out the file name to use
- if ($fileInfo{SourceFile}) {
- $$database{$fileInfo{SourceFile}} = \%fileInfo;
- $found = 1;
- }
- } else {
- # the first row should be the tag names
- foreach (@vals) {
- # terminate at first blank tag name (eg. extra comma at end of line)
- last unless length $_;
- @tags or s/^\xef\xbb\xbf//; # remove UTF-8 BOM if it exists
- /^[-\w]+(:[-\w+]+)?#?$/ or $err = "Invalid tag name '$_'", last;
- push(@tags, $_);
- }
- last if $err;
- @tags or $err = 'No tags found', last;
- }
- }
- close CSVFILE if $openedFile;
- undef $raf;
- $err = 'No SourceFile column' unless $found or $err;
- return $err ? "$err in $file" : undef;
- }
- #------------------------------------------------------------------------------
- # Convert unicode code point to UTF-8
- # Inputs: 0) integer Unicode character
- # Returns: UTF-8 bytes
- sub ToUTF8($)
- {
- require Image::ExifTool::Charset;
- return Image::ExifTool::Charset::Recompose(undef, [$_[0]], $charset);
- }
- #------------------------------------------------------------------------------
- # Read JSON object from file
- # Inputs: 0) JSON file handle, 1) optional file buffer reference
- # Returns: JSON object (scalar, hash ref, or array ref), or undef on EOF or
- # empty object or array (and sets $$buffPt to empty string on EOF)
- # Notes: position in buffer is significant
- sub ReadJSONObject($;$)
- {
- my ($fp, $buffPt) = @_;
- # initialize buffer if necessary
- my ($pos, $readMore, $rtnVal, $tok, $key, $didBOM);
- if ($buffPt) {
- $pos = pos $$buffPt;
- } else {
- my $buff = '';
- $buffPt = \$buff;
- $pos = 0;
- }
- Tok: for (;;) {
- if ($pos >= length $$buffPt or $readMore) {
- # read another 64kB and add to unparsed data
- my $offset = length($$buffPt) - $pos;
- $$buffPt = substr($$buffPt, $pos) if $offset;
- ($fp and read $fp, $$buffPt, 65536, $offset) or $$buffPt = '', last;
- unless ($didBOM) {
- $$buffPt =~ s/^\xef\xbb\xbf//; # remove UTF-8 BOM if it exists
- $didBOM = 1;
- }
- $pos = pos($$buffPt) = 0;
- $readMore = 0;
- }
- unless ($tok) {
- # skip white space and find next character
- $$buffPt =~ /(\S)/g or $pos = length($$buffPt), next;
- $tok = $1;
- $pos = pos $$buffPt;
- }
- # see what type of object this is
- if ($tok eq '{') { # object (hash)
- $rtnVal = { } unless defined $rtnVal;
- for (;;) {
- # read "KEY":"VALUE" pairs
- unless (defined $key) {
- $key = ReadJSONObject($fp, $buffPt);
- $pos = pos $$buffPt;
- }
- # ($key may be undef for empty JSON object)
- if (defined $key) {
- # scan to delimiting ':'
- $$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
- $1 eq ':' or return undef; # error if not a colon
- my $val = ReadJSONObject($fp, $buffPt);
- $pos = pos $$buffPt;
- return undef unless defined $val;
- $$rtnVal{$key} = $val;
- undef $key;
- }
- # scan to delimiting ',' or bounding '}'
- $$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
- last if $1 eq '}'; # check for end of object
- $1 eq ',' or return undef; # error if not a comma
- }
- } elsif ($tok eq '[') { # array
- $rtnVal = [ ] unless defined $rtnVal;
- for (;;) {
- my $item = ReadJSONObject($fp, $buffPt);
- $pos = pos $$buffPt;
- # ($item may be undef for empty array)
- push @$rtnVal, $item if defined $item;
- # scan to delimiting ',' or bounding ']'
- $$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
- last if $1 eq ']'; # check for end of array
- $1 eq ',' or return undef; # error if not a comma
- }
- } elsif ($tok eq '"') { # quoted string
- for (;;) {
- $$buffPt =~ /(\\*)"/g or $readMore = 1, next Tok;
- last unless length($1) & 1; # check for escaped quote
- }
- $rtnVal = substr($$buffPt, $pos, pos($$buffPt)-$pos-1);
- # unescape characters
- $rtnVal =~ s/\\u([0-9a-f]{4})/ToUTF8(hex $1)/ige;
- $rtnVal =~ s/\\(.)/$unescapeJSON{$1}||$1/sge;
- # decode base64 (binary data) values
- if ($rtnVal =~ /^base64:[A-Za-z0-9+\/]*={0,2}$/ and length($rtnVal) % 4 == 3) {
- require Image::ExifTool::XMP;
- $rtnVal = ${Image::ExifTool::XMP::DecodeBase64(substr($rtnVal,7))};
- }
- } elsif ($tok eq ']' or $tok eq '}' or $tok eq ',') {
- # return undef for empty object, array, or list item
- # (empty list item actually not valid JSON)
- pos($$buffPt) = pos($$buffPt) - 1;
- } else { # number, 'true', 'false', 'null'
- $$buffPt =~ /([\s:,\}\]])/g or $readMore = 1, next;
- pos($$buffPt) = pos($$buffPt) - 1;
- $rtnVal = $tok . substr($$buffPt, $pos, pos($$buffPt)-$pos);
- }
- last;
- }
- return $rtnVal;
- }
- #------------------------------------------------------------------------------
- # Read JSON file
- # Inputs: 0) JSON file name or file ref, 1) database hash ref,
- # 2) flag to delete "-" tags, 3) character set
- # Returns: undef on success, or error string
- sub ReadJSON($$;$$)
- {
- local $_;
- my ($file, $database, $missingValue, $chset) = @_;
- my ($fp, $openedFile);
- # initialize character set for converting "\uHHHH" chars
- $charset = $chset || 'UTF8';
- if (ref $file eq 'GLOB') {
- $fp = $file;
- $file = 'JSON file';
- } else {
- open JSONFILE, $file or return "Error opening JSON file '$file'";
- binmode JSONFILE;
- $fp = \*JSONFILE;
- $openedFile = 1;
- }
- my $obj = ReadJSONObject($fp);
- close $fp if $openedFile;
- unless (ref $obj eq 'ARRAY') {
- ref $obj eq 'HASH' or return "Format error in JSON file '$file'";
- $obj = [ $obj ];
- }
- my ($info, $found);
- foreach $info (@$obj) {
- next unless ref $info eq 'HASH';
- # assume a SourceFile of '*' if none specified
- defined $$info{SourceFile} or $$info{SourceFile} = '*';
- if (defined $missingValue) {
- $$info{$_} eq $missingValue and $$info{$_} = undef foreach keys %$info;
- }
- $$database{$$info{SourceFile}} = $info;
- $found = 1;
- }
- return $found ? undef : "No valid JSON objects in '$file'";
- }
- 1; # end
- __END__
- =head1 NAME
- Image::ExifTool::Import - Import CSV and JSON database files
- =head1 SYNOPSIS
- use Image::ExifTool::Import qw(ReadCSV ReadJSON);
- $err = ReadCSV($csvFile, \%database);
- $err = ReadJSON($jsonfile, \%database);
- =head1 DESCRIPTION
- This module contains routines for importing tag information from CSV (Comma
- Separated Value) and JSON (JavaScript Object Notation) database files.
- =head1 EXPORTS
- Exports nothing by default, but ReadCSV and ReadJSON may be exported.
- =head1 METHODS
- =head2 ReadCSV / ReadJSON
- Read CSV or JSON file into a database hash.
- =over 4
- =item Inputs:
- 0) CSV file name or file reference.
- 1) Hash reference for database object.
- 2) Optional string used to represent an undefined (missing) tag value.
- (Used for deleting tags.)
- 3) [ReadJSON only] Optional character set for converting Unicode escape
- sequences in strings. Defaults to "UTF8". See the ExifTool Charset option
- for a list of valid settings.
- =item Return Value:
- These functions return an error string, or undef on success and populate the
- database hash with entries from the CSV or JSON file. Entries are keyed
- based on the SourceFile column of the CSV or JSON information, and are
- stored as hash lookups of tag name/value for each SourceFile.
- =back
- =head1 AUTHOR
- Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
- This library is free software; you can redistribute it and/or modify it
- under the same terms as Perl itself.
- =head1 SEE ALSO
- L<Image::ExifTool(3pm)|Image::ExifTool>
- =cut
|