Import.pm 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329
  1. #------------------------------------------------------------------------------
  2. # File: Import.pm
  3. #
  4. # Description: Import CSV and JSON database files
  5. #
  6. # Revisions: 2011-03-05 - P. Harvey Created
  7. #------------------------------------------------------------------------------
  8. package Image::ExifTool::Import;
  9. use strict;
  10. require Exporter;
  11. use vars qw($VERSION @ISA @EXPORT_OK);
  12. $VERSION = '1.05';
  13. @ISA = qw(Exporter);
  14. @EXPORT_OK = qw(ReadCSV ReadJSON);
  15. sub ReadJSONObject($;$);
  16. my %unescapeJSON = ( 't'=>"\t", 'n'=>"\n", 'r'=>"\r" );
  17. my $charset;
  18. #------------------------------------------------------------------------------
  19. # Read CSV file
  20. # Inputs: 0) CSV file name or file ref, 1) database hash ref, 2) missing tag value
  21. # Returns: undef on success, or error string
  22. # Notes: There are various flavours of CSV, but here we assume that only
  23. # double quotes are escaped, and they are escaped by doubling them
  24. sub ReadCSV($$;$)
  25. {
  26. local ($_, $/);
  27. my ($file, $database, $missingValue) = @_;
  28. my ($buff, @tags, $found, $err, $raf, $openedFile);
  29. if (ref $file eq 'GLOB') {
  30. $raf = new File::RandomAccess($file);
  31. $file = 'CSV file';
  32. } else {
  33. open CSVFILE, $file or return "Error opening CSV file '$file'";
  34. binmode CSVFILE;
  35. $openedFile = 1;
  36. $raf = new File::RandomAccess(\*CSVFILE);
  37. }
  38. # set input record separator by first newline found in the file
  39. # (safe because first line should contain only tag names)
  40. while ($raf->Read($buff, 65536)) {
  41. $buff =~ /(\x0d\x0a|\x0d|\x0a)/ and $/ = $1, last;
  42. }
  43. $raf->Seek(0,0);
  44. while ($raf->ReadLine($buff)) {
  45. my (@vals, $v, $i, %fileInfo);
  46. my @toks = split ',', $buff;
  47. while (@toks) {
  48. ($v = shift @toks) =~ s/^ +//; # remove leading spaces
  49. if ($v =~ s/^"//) {
  50. # quoted value must end in an odd number of quotes
  51. while ($v !~ /("+)\s*$/ or not length($1) & 1) {
  52. if (@toks) {
  53. $v .= ',' . shift @toks;
  54. } else {
  55. # read another line from the file
  56. $raf->ReadLine($buff) or last;
  57. @toks = split ',', $buff;
  58. last unless @toks;
  59. $v .= shift @toks;
  60. }
  61. }
  62. $v =~ s/"\s*$//; # remove trailing quote and whitespace
  63. $v =~ s/""/"/g; # un-escape quotes
  64. } else {
  65. $v =~ s/[ \n\r]+$//;# remove trailing spaces/newlines
  66. }
  67. push @vals, $v;
  68. }
  69. if (@tags) {
  70. # save values for each tag
  71. for ($i=0; $i<@vals and $i<@tags; ++$i) {
  72. next unless length $vals[$i]; # ignore empty entries
  73. # delete tag (set value to undef) if value is same as missing tag
  74. $fileInfo{$tags[$i]} =
  75. (defined $missingValue and $vals[$i] eq $missingValue) ? undef : $vals[$i];
  76. }
  77. # figure out the file name to use
  78. if ($fileInfo{SourceFile}) {
  79. $$database{$fileInfo{SourceFile}} = \%fileInfo;
  80. $found = 1;
  81. }
  82. } else {
  83. # the first row should be the tag names
  84. foreach (@vals) {
  85. # terminate at first blank tag name (eg. extra comma at end of line)
  86. last unless length $_;
  87. @tags or s/^\xef\xbb\xbf//; # remove UTF-8 BOM if it exists
  88. /^[-\w]+(:[-\w+]+)?#?$/ or $err = "Invalid tag name '$_'", last;
  89. push(@tags, $_);
  90. }
  91. last if $err;
  92. @tags or $err = 'No tags found', last;
  93. }
  94. }
  95. close CSVFILE if $openedFile;
  96. undef $raf;
  97. $err = 'No SourceFile column' unless $found or $err;
  98. return $err ? "$err in $file" : undef;
  99. }
  100. #------------------------------------------------------------------------------
  101. # Convert unicode code point to UTF-8
  102. # Inputs: 0) integer Unicode character
  103. # Returns: UTF-8 bytes
  104. sub ToUTF8($)
  105. {
  106. require Image::ExifTool::Charset;
  107. return Image::ExifTool::Charset::Recompose(undef, [$_[0]], $charset);
  108. }
  109. #------------------------------------------------------------------------------
  110. # Read JSON object from file
  111. # Inputs: 0) JSON file handle, 1) optional file buffer reference
  112. # Returns: JSON object (scalar, hash ref, or array ref), or undef on EOF or
  113. # empty object or array (and sets $$buffPt to empty string on EOF)
  114. # Notes: position in buffer is significant
  115. sub ReadJSONObject($;$)
  116. {
  117. my ($fp, $buffPt) = @_;
  118. # initialize buffer if necessary
  119. my ($pos, $readMore, $rtnVal, $tok, $key, $didBOM);
  120. if ($buffPt) {
  121. $pos = pos $$buffPt;
  122. } else {
  123. my $buff = '';
  124. $buffPt = \$buff;
  125. $pos = 0;
  126. }
  127. Tok: for (;;) {
  128. if ($pos >= length $$buffPt or $readMore) {
  129. # read another 64kB and add to unparsed data
  130. my $offset = length($$buffPt) - $pos;
  131. $$buffPt = substr($$buffPt, $pos) if $offset;
  132. ($fp and read $fp, $$buffPt, 65536, $offset) or $$buffPt = '', last;
  133. unless ($didBOM) {
  134. $$buffPt =~ s/^\xef\xbb\xbf//; # remove UTF-8 BOM if it exists
  135. $didBOM = 1;
  136. }
  137. $pos = pos($$buffPt) = 0;
  138. $readMore = 0;
  139. }
  140. unless ($tok) {
  141. # skip white space and find next character
  142. $$buffPt =~ /(\S)/g or $pos = length($$buffPt), next;
  143. $tok = $1;
  144. $pos = pos $$buffPt;
  145. }
  146. # see what type of object this is
  147. if ($tok eq '{') { # object (hash)
  148. $rtnVal = { } unless defined $rtnVal;
  149. for (;;) {
  150. # read "KEY":"VALUE" pairs
  151. unless (defined $key) {
  152. $key = ReadJSONObject($fp, $buffPt);
  153. $pos = pos $$buffPt;
  154. }
  155. # ($key may be undef for empty JSON object)
  156. if (defined $key) {
  157. # scan to delimiting ':'
  158. $$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
  159. $1 eq ':' or return undef; # error if not a colon
  160. my $val = ReadJSONObject($fp, $buffPt);
  161. $pos = pos $$buffPt;
  162. return undef unless defined $val;
  163. $$rtnVal{$key} = $val;
  164. undef $key;
  165. }
  166. # scan to delimiting ',' or bounding '}'
  167. $$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
  168. last if $1 eq '}'; # check for end of object
  169. $1 eq ',' or return undef; # error if not a comma
  170. }
  171. } elsif ($tok eq '[') { # array
  172. $rtnVal = [ ] unless defined $rtnVal;
  173. for (;;) {
  174. my $item = ReadJSONObject($fp, $buffPt);
  175. $pos = pos $$buffPt;
  176. # ($item may be undef for empty array)
  177. push @$rtnVal, $item if defined $item;
  178. # scan to delimiting ',' or bounding ']'
  179. $$buffPt =~ /(\S)/g or $readMore = 1, next Tok;
  180. last if $1 eq ']'; # check for end of array
  181. $1 eq ',' or return undef; # error if not a comma
  182. }
  183. } elsif ($tok eq '"') { # quoted string
  184. for (;;) {
  185. $$buffPt =~ /(\\*)"/g or $readMore = 1, next Tok;
  186. last unless length($1) & 1; # check for escaped quote
  187. }
  188. $rtnVal = substr($$buffPt, $pos, pos($$buffPt)-$pos-1);
  189. # unescape characters
  190. $rtnVal =~ s/\\u([0-9a-f]{4})/ToUTF8(hex $1)/ige;
  191. $rtnVal =~ s/\\(.)/$unescapeJSON{$1}||$1/sge;
  192. # decode base64 (binary data) values
  193. if ($rtnVal =~ /^base64:[A-Za-z0-9+\/]*={0,2}$/ and length($rtnVal) % 4 == 3) {
  194. require Image::ExifTool::XMP;
  195. $rtnVal = ${Image::ExifTool::XMP::DecodeBase64(substr($rtnVal,7))};
  196. }
  197. } elsif ($tok eq ']' or $tok eq '}' or $tok eq ',') {
  198. # return undef for empty object, array, or list item
  199. # (empty list item actually not valid JSON)
  200. pos($$buffPt) = pos($$buffPt) - 1;
  201. } else { # number, 'true', 'false', 'null'
  202. $$buffPt =~ /([\s:,\}\]])/g or $readMore = 1, next;
  203. pos($$buffPt) = pos($$buffPt) - 1;
  204. $rtnVal = $tok . substr($$buffPt, $pos, pos($$buffPt)-$pos);
  205. }
  206. last;
  207. }
  208. return $rtnVal;
  209. }
  210. #------------------------------------------------------------------------------
  211. # Read JSON file
  212. # Inputs: 0) JSON file name or file ref, 1) database hash ref,
  213. # 2) flag to delete "-" tags, 3) character set
  214. # Returns: undef on success, or error string
  215. sub ReadJSON($$;$$)
  216. {
  217. local $_;
  218. my ($file, $database, $missingValue, $chset) = @_;
  219. my ($fp, $openedFile);
  220. # initialize character set for converting "\uHHHH" chars
  221. $charset = $chset || 'UTF8';
  222. if (ref $file eq 'GLOB') {
  223. $fp = $file;
  224. $file = 'JSON file';
  225. } else {
  226. open JSONFILE, $file or return "Error opening JSON file '$file'";
  227. binmode JSONFILE;
  228. $fp = \*JSONFILE;
  229. $openedFile = 1;
  230. }
  231. my $obj = ReadJSONObject($fp);
  232. close $fp if $openedFile;
  233. unless (ref $obj eq 'ARRAY') {
  234. ref $obj eq 'HASH' or return "Format error in JSON file '$file'";
  235. $obj = [ $obj ];
  236. }
  237. my ($info, $found);
  238. foreach $info (@$obj) {
  239. next unless ref $info eq 'HASH';
  240. # assume a SourceFile of '*' if none specified
  241. defined $$info{SourceFile} or $$info{SourceFile} = '*';
  242. if (defined $missingValue) {
  243. $$info{$_} eq $missingValue and $$info{$_} = undef foreach keys %$info;
  244. }
  245. $$database{$$info{SourceFile}} = $info;
  246. $found = 1;
  247. }
  248. return $found ? undef : "No valid JSON objects in '$file'";
  249. }
  250. 1; # end
  251. __END__
  252. =head1 NAME
  253. Image::ExifTool::Import - Import CSV and JSON database files
  254. =head1 SYNOPSIS
  255. use Image::ExifTool::Import qw(ReadCSV ReadJSON);
  256. $err = ReadCSV($csvFile, \%database);
  257. $err = ReadJSON($jsonfile, \%database);
  258. =head1 DESCRIPTION
  259. This module contains routines for importing tag information from CSV (Comma
  260. Separated Value) and JSON (JavaScript Object Notation) database files.
  261. =head1 EXPORTS
  262. Exports nothing by default, but ReadCSV and ReadJSON may be exported.
  263. =head1 METHODS
  264. =head2 ReadCSV / ReadJSON
  265. Read CSV or JSON file into a database hash.
  266. =over 4
  267. =item Inputs:
  268. 0) CSV file name or file reference.
  269. 1) Hash reference for database object.
  270. 2) Optional string used to represent an undefined (missing) tag value.
  271. (Used for deleting tags.)
  272. 3) [ReadJSON only] Optional character set for converting Unicode escape
  273. sequences in strings. Defaults to "UTF8". See the ExifTool Charset option
  274. for a list of valid settings.
  275. =item Return Value:
  276. These functions return an error string, or undef on success and populate the
  277. database hash with entries from the CSV or JSON file. Entries are keyed
  278. based on the SourceFile column of the CSV or JSON information, and are
  279. stored as hash lookups of tag name/value for each SourceFile.
  280. =back
  281. =head1 AUTHOR
  282. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  283. This library is free software; you can redistribute it and/or modify it
  284. under the same terms as Perl itself.
  285. =head1 SEE ALSO
  286. L<Image::ExifTool(3pm)|Image::ExifTool>
  287. =cut