#!/usr/bin/perl -CADS # This program is free software. It comes without any warranty, to the # extent permitted by applicable law. You can redistribute it and/or # modify it under the terms of the Do What The Fuck You Want To Public # License, Version 2, as published by Sam Hocevar. # See http://sam.zoy.org/wtfpl/COPYING for more details. $VERSION = "0.3, 01 March 2012"; use warnings; use strict; use utf8; use feature "unicode_strings"; use Getopt::Long qw/:config noauto_abbrev no_ignore_case gnu_compat bundling permute nogetopt_compat auto_version auto_help/; use Pod::Usage; use Locale::Language qw /code2language LOCALE_LANG_ALPHA_2 LOCALE_LANG_ALPHA_3/; use IPC::Open3; use File::Basename qw /basename/; use File::Spec::Functions; use File::Copy qw /move/; use Env qw /HOME/; use Switch qw /Perl6/; use Encode; ################################################################################ # Configuration my $confile = catfile ($HOME, '.videodb.rc'); die "Error: Can't read `" .$confile. "'.\n" unless -f $confile; my %config = do $confile; die "Error in `" .$confile. "'.\n" if $@ || not %config; map { exists $config{$_} || die "Error: Missing `${_}'.\n" } qw /videodir driver database hostname user password userid imdb url/; $config{prefix} = "" unless exists $config{prefix}; my $symlinks = catdir($config{videodir},'MOVIES'); # Symlinks folder die "Error: No such directory: `" .$symlinks. "'.\n" unless -d $symlinks; my $directors = catdir($config{videodir},'DIRECTORS'); # Directors folder die "Error: No such directory: `" .$directors. "'.\n" unless -d $symlinks; my %imdb = ( host => $config{imdb}, debug => 0 ); $config{url} =~ s/\/*$//; ################################################################################ =head1 NAME videoadd.pl - add/update movies to your collection =head1 SYNOPSIS B [B<-s>] [B<-u>] [B<--ignore-db>] [B<--dont-move>] [B<--force>] [B<-i> I] [B<-o> I...] [B<--only=>I...] [B<--exclude=>I...] [B<-q>] (I|I|I<id>|I<IMDbID>) =head1 DISCLAIMER Your collection is assumed to have the following structure: two folders, I<DIRECTORS> and I<MOVIES>, that have the same parent. I<DIRECTORS> contains one subdirectory for each director, and each movie lies (B<as a regular file>) in the subdirectory of its director. The folder I<MOVIES> contains symlinks - one for each movie - that target to I<../DIRECTORS/director_of_the_movie/movie>. The behavior of B<videoadd.pl> is NOT specified if your collection does not verify these conventions! |- ... |- DIRECTORS | |- director1 | |- |- movie11 | | `- movie12 | |- director2/ | `- ... `- MOVIES |- movie11 -> ../DIRECTORS/director1/movie1 |- movie12 -> ../DIRECTORS/director1/movie2 `- ... =head1 DESCRIPTION C<videoadd.pl arg> starts by trying to match I<arg> against the IDs or IMDb IDs (if I<arg> contains only digits), filenames (if I<arg> has a known video extension), or titles (with wildcards; succeeds if I<args> is contained in a title) of the database. If matching entries are found, then the user is prompted to choose for an entry to update, or to ignore these entries. In the former case, the above file hierarchy remains unchanged and the database is merely updated with the new retrieved data. In the later case, B<videoadd.pl> acts as below. If no matching entry is found, I<arg> should be an existing file, and the correspoding movie is added to the collection. Various data such as the movie length, the A/V codecs, etc. are read from the metadata of I<arg> via B<mplayer>. One can fetch other data (e.g., year, director, cast, etc.) from IMDb (option B<-i>). If there is a clash (e.g., language) the metadata take precedence. The database is then updated with the new movie (unless B<--ignore-db> is set), which in turn is put in the right place of the above file hierarchy (unless B<--dont-move> is set). =head1 OPTIONS =over 8 =item B<-s>, B<--seen> Mark the movie as seen for the I<userid> of the configuration file. =item B<-u>, B<--unseen> Mark the movie as unseen for the I<userid> of the configuration file. (This flag is ignored unless the action is to update an existing movie in the database) =item B<--ignore-db> Do not connect to the database, hence do not update it with the new movie, but only move it to the right place in the file hierarchy. Note that it may break the sanity of your collection. =item B<--dont-move> Do not put the new movie in I<DIRECTORS/director/movie>, with a symlink I<MOVIES/movie> -> I<../DIRECTORS/director/movie>, but only update the database. Note that it may break the sanity of your collection. =item B<--force> Do not ask the user before updating existing entries in the database. If more that one matching entry is found while B<--force> is set, B<videoadd.pl> exits with a non-zero status. =item B<-i> I<crit>, B<--imdb=>I<crit> Search for the given criterion (e.g., a movie title or an IMDb ID) on IMDb. The retrieved data (such as year, director, cast, etc.) will be added to the database (unless overriden by B<-o> I<key=value>). =item B<-o> I<key=value>, B<--option=>I<key=value> Override data from IMDb with the I<value> provided. Valid I<key>s are I<title>, I<language >, I<imdbid>, I<year>, I<imgurl>, I<director>, I<genres>, I<country>, I<plot>, I<rating>, I<istv>. =item B<--only=>I<field,field,>... Update only the given fields of the database. Known fields are I<title>, I<subtitle>, I<language>, I<imdbid>, I<year>, I<imgurl>, I<director>, I<actors>, I<country>, I<plot>, I<genres>, I<rating>, I<istv>, I<filename>, I<filesize>, I<filedate>, I<video_codec>, I<audio_codec>, I<video_width>, I<video_height>, I<runtime>, I<custom1>, I<custom2>, I<custom3>, I<custom4>. Two meta-fields are also available: =over 4 =item * I<imdb>, which stands for I<title>, I<subtitle>, I<language>, I<imdbid>, I<year>, I<imgurl>, I<director>, I<actors>, I<country>, I<plot>, I<genres>, I<rating>, I<istv>, and =item * I<file>, which stands for I<filename>, I<filesize>, I<filedate>, I<video_codec>, I<audio_codec>, I<video_width>, I<video_height>, I<runtime>, I<language>. =back =item B<--exclude=>I<field,field,>... Do not update the given fields of the database. See B<--only> above for details. =item B<-q>, B<--quiet> Do not print the final URL for the freshly added/updated movie. =back =head1 CONFIGURATION B<videoadd> reads its database configuration from the file I<$HOME/.videodb.rc>. This file has to be the content of a Perl hash e.g., videodir => catdir($HOME,'video'), driver => 'mysql', database => 'videodb', hostname => 'example.org', user => 'username', port => 3306, password => '******', prefix => "videodb_", userid => 1, imdb => 'akas.imdb.com', url => 'https://videodb.example.org', =head1 REQUIREMENTS The imported modules are available on CPAN. See the source for details. =head1 AUTHOR Copyright 2012 Guilhem Moulin. See the source for copying conditions. =cut ################################################################################ my $ignoredb_flag; my $seen_flag; my $force_update_flag; my $unseen_flag; my $move_flag = 1; my %options; my @only; my @exclude; GetOptions( "s|seen" => \$seen_flag , "u|unseen" => \$unseen_flag , "ignore-db" => \$ignoredb_flag , "dont-move" => sub { undef $move_flag } , "force" => \$force_update_flag , "i|imdb=s" => sub { $imdb{crit} = $_[1] } , "o|option=s"=> sub { my ($k,$v) = split /=/, $_[1], 2; $options{lc $k} = $v; } , "only=s" => sub { @only = &keywords (split /,/, $_[1]) } , "exclude=s" => sub { @exclude = &keywords (split /,/, $_[1]) } , "q|quiet=s" => sub { open LOG, '>', '/dev/null' or die "Cannot open `/dev/null': $!" } , "man" => sub { pod2usage(-exitstatus => 0, -verbose => 2) } ) or pod2usage(2); pod2usage(2) if $#ARGV != 0; *LOG = *STDERR unless defined (fileno LOG); ################################################################################ # Connection to the database my $dbh; unless ( defined $ignoredb_flag ) { require DBI; import DBI; # Connect to database my $dsn = "DBI:$config{driver}:database=$config{database};host=$config{hostname}"; $dsn .= ";port=$config{port}" if defined $config{port}; if (defined $config{dbi_misc}) { while (my ($k,$v) = each %{$config{dbi_misc}}) { $dsn .= ";$k=$v"; } } $dbh = DBI->connect($dsn, $config{user}, $config{password}) or die "Error: Can't connect do database.\n"; } my $id; my $file = &getfile ($ARGV[0]); my %new = ( owner_id => $config{userid} , customs => {}); ################################################################################ # Look on-line for information on the movie if ( defined ($imdb{crit}) and &runIMDb() ) { # Look up the title/ID on IMDb require IMDB::Film; import IMDB::Film; my $single; my $movie; do { $movie = new IMDB::Film(%imdb); die "IMDb error: " .$movie->error. "\n" unless $movie->status; my @matches = @{$movie->matched}; if (@matches) { # Got several results; Print them, and ask the user to pick up an ID die "No result found.\n" unless defined $matches[0]->{id}; print "Found " .(1+$#matches). " matching entries:\n" or die "Can't print: $!"; my @options; foreach ( @matches ) { print &iconv($_->{id}. ' - ' .$_->{title}. "\n") or die "Can't print: $!"; push @options, $_->{id}; } for (my $i=0; $i<72; $i++) {print '=' or die "Can't print: $!"}; print "\n" or die "Can't print: $!"; $imdb{crit} = &question ( \@options, "Choose an IMDb ID above, to retrieve data for:", $options[0] ); } else { $single = 1; } } until defined $single; # Got a single result; Process the movie $new{title} = $movie->title(); $new{language} = lc join (', ', @{$movie->language()}); $new{imdbid} = 'imdb:' .$movie->id(); $new{year} = $movie->year(); $new{imgurl} = $movie->cover(); $new{director} = join ', ', map {$_->{name}} @{$movie->directors()}; $new{actors} = join "\n", map {&mkcast($_)} @{$movie->full_cast()}; $new{country} = join ', ', @{$movie->country()}; $new{plot} = $movie->storyline(); # TODO; plot vs. full_plot vs. storyline? $new{genres} = $movie->genres(); $new{rating} = $movie->rating(); # Ignoring #votes and awards $new{istv} = 1 if $movie->kind() =~ /tv/; } elsif (defined $file) { # Fill in at least the title, based on the file name... $new{title} = basename ($file); $new{title} =~ s/.(avi|ogm|ogg|bin|mpe?g|ra?m|mov|asf|wmv|mkv)$//i; } # Override imdDB's information with the ones provided foreach my $k (keys %options) { die "Error: Unknown key `" .$k. "'.\n" unless grep { $_ eq $k } qw/title language imdbid year imgurl genres director country plot rating istv/; $new{$k} = $options{$k}; $new{$k} = [ split /,\s*/, $new{$k} ] if $k eq 'genres'; } ################################################################################ # Run mplayer on the given file to get A/V codecs, etc. if ( defined $file ) { $new{filename} = basename ($file); $new{filesize} = (stat $file)[7]; $new{filedate} = (stat $file)[9]; # Last modify time in seconds since epoch } if ( defined($file) and &runMplayer() ) { my @cmd = ('mplayer', '-identify', '-ao', 'null', '-vo', 'null', '-frames', '0', $file); open NULL, '+<', '/dev/null' or die "Can't open `/dev/null': $!"; open3 '<&NULL', my $OUT, ">&NULL", @cmd or die "Can't run mplayer"; my (@alang, @slang); foreach my $line (<$OUT>) { next unless $line =~ m/^ID_/; chomp $line; if ( $line =~ m/^ID_VIDEO_FORMAT=(.*)/ ) { $new{video_codec} = &video_codec($1); } elsif ( $line =~ m/^ID_AUDIO_FORMAT=(.*)/ ) { $new{audio_codec} = &audio_codec($1); } elsif ( $line =~ m/^ID_VIDEO_WIDTH=(.*)/ ) { $new{video_width} = $1; } elsif ( $line =~ m/^ID_VIDEO_HEIGHT=(.*)/ ) { $new{video_height} = $1; } elsif ( $line =~ m/^ID_LENGTH=(.*)/ ) { $new{runtime} = $1; die "I won't mess up the db with your crappy empty movie.\n" if $new{runtime} =~ /^0*\.?0*$/; $new{runtime} = sprintf "%d", $new{runtime}/60; } elsif ( $line =~ m/^ID_AID_\d+_LANG=(.*)/ ) { push @alang, &code2lang ($1); } elsif ( $line =~ m/^ID_SID_\d+_LANG=(.*)/ ) { push @slang, &code2lang ($1); } }; $new{language} = lc join (', ', @alang) unless $#alang < 0 and defined $imdb{crit}; # The "Subtitles" field is not hard-coded: insert it in the "custom" field instead $new{customs}->{subtitles} = lc join (', ', @slang); } ################################################################################ # Insertion into the database unless ( defined $ignoredb_flag ) { # Handle custom fields my $customs = $dbh->selectall_arrayref ( "SELECT opt,value FROM $config{prefix}config WHERE opt REGEXP '^custom[1-9]+\$'" ) or die "Can't select: $!\n"; foreach my $c (@$customs) { if (grep {lc $_ eq lc $c->[1]} (keys %{$new{customs}})) { $new{$c->[0]} = &iconv($new{customs}->{lc $c->[1]}); } } delete $new{customs}; # Get the (first found) mediatype for files on the hard disk my $mediatype = $dbh->selectrow_arrayref( "SELECT id FROM $config{prefix}mediatypes WHERE name = ?", undef, 'HDD' ) or die "Can't select. (Unknown mediatype `HDD'?)\n"; # Get the genre IDs my @genres; if (&include('genres') and defined ($new{genres}) and @{$new{genres}}) { my $sth_selgenre = $dbh->prepare( "SELECT id FROM $config{prefix}genres WHERE name = ?" ) or die "Error: " .$dbh->errstr; my $sth_insgenre = $dbh->prepare( "INSERT INTO $config{prefix}genres SET name = ?" ) or die "Error: " .$dbh->errstr; foreach my $g (@{$new{genres}}) { $g = &iconv($g); $sth_selgenre->execute ($g); my @gids = $sth_selgenre->fetchrow_array; die $sth_selgenre->errstr if $sth_selgenre->err; unless (@gids) { # Insert non existing genres $sth_insgenre->execute ($g); die $sth_insgenre->errstr if $sth_insgenre->err; $sth_selgenre->execute ($g); @gids = $sth_selgenre->fetchrow_array; die $sth_selgenre->errstr if $sth_selgenre->err; } push @genres, @gids; } $sth_selgenre->finish; $sth_insgenre->finish; } delete $new{genres}; foreach my $k (keys %new) { $new{$k} = &iconv($new{$k}); } my @SET; if (&include('filedate') && defined $new{filedate}) { push @SET, "filedate = FROM_UNIXTIME($new{filedate})"; delete $new{filedate}; } push @SET, "mediatype = $mediatype->[0]" if defined ($mediatype) and defined ($mediatype->[0]); while (my ($k,$v) = each %new) { next unless &include ($k); push @SET, $k. " = " .$dbh->quote ($v) if defined $v; } my $ok = 1; if (defined $id) { # We got an already existing movie push @SET, "lastupdate = NOW()"; $dbh->do( "UPDATE $config{prefix}videodata SET " .join (', ', @SET). " WHERE id = $id" ) or die "Can't update: $!\n"; if (&include ('genres')) { $dbh->do( "DELETE FROM $config{prefix}videogenre WHERE video_id = $id" ) or die "Can't delete: $!\n"; } if (defined $unseen_flag) { $dbh->do( "DELETE FROM $config{prefix}userseen WHERE video_id = $id AND user_id = $config{userid}" ) or die "Can't delete: $!\n"; } } else { # We got a fresh movie to insert push @SET, "created = NOW()"; $dbh->do( "INSERT INTO $config{prefix}videodata SET " .join (', ', @SET) ) or die "Can't insert: $!\n"; my $ids = $dbh->selectall_arrayref ( "SELECT id FROM $config{prefix}videodata WHERE filename = ? ", undef, $new{filename} ) or die "Can't select: $!\n"; if ($#$ids == 0) { $id = $ids->[0]->[0]; } else { $ok = 0; warn "Warning: Something weird happened during the INSERT. You should probably sanity check your collection.\n"; } } if ($ok) { # Update the userseen & videogenre tables if (defined $seen_flag) { $dbh->do( "INSERT INTO $config{prefix}userseen SET video_id = $id, user_id = $config{userid}" ) or die "Can't insert: $!\n"; } if (&include ('genres')) { my $sth_insgenre = $dbh->prepare( "INSERT INTO $config{prefix}videogenre SET video_id = $id, genre_id = ?" ) or die "Error: " .$dbh->errstr; foreach (@genres) { $sth_insgenre->execute ($_); die $sth_insgenre->errstr if $sth_insgenre->err; } $sth_insgenre->finish; } print "\a" or die "Can't print: $!"; print LOG "Check it out! ", $config{url}. "/show.php?id=" .$id, "\n" or die "Can't print: $!"; } $dbh->disconnect; } ################################################################################ # Move the file to the right place in the hierarchy if ( defined ($file) and defined ($move_flag) ) { if (defined $new{director}) { my $dir = catdir ( $directors, $new{director} ); unless (-d $dir) { print STDERR "Directory `$dir' does not exist. "; my $answer = &YNquestion( "Should I create it?", 'y' ); if ($answer eq 'y') { mkdir $dir or die "Error: Cannot mkdir `$dir': $!\n"; } else { exit 0; } } if ( -e catfile ( $dir, $new{filename} ) ) { warn "Warning: Cannot move file: file exists.\n"; } else { move ( $file, catfile ( $dir, $new{filename} ) ) or warn "Warning: Cannot move file: $!.\n"; } if ( -e catfile( $symlinks, $new{filename} ) ) { warn "Warning: Cannot create symlink: file exists.\n"; } else { symlink catfile( updir(), 'DIRECTORS', $new{director}, $new{filename} ), catfile( $symlinks, $new{filename} ) or warn "Warning: Cannot create symlink: $!.\n"; } } else { warn "Warning: Cannot move file (no director found).\n" } } ################################################################################ exit 0; # Useless, but Perl doesn't see that this filehandle is used more than once close NULL; # Automatically closed by `open3' ################################################################################ # Transform codec codes into proper names # TODO: Find more codes sub video_codec { given ($_[0]) { when /^0x10000001$/i { return 'MPEG-1'; } when /^0x10000002$/i { return 'MPEG-2'; } when /^(MPG4|MP4V)$/i { return 'MPEG-4'; } when /^MP42$/i { return 'MS MPEG-4 v2'; } when /^MP43$/i { return 'MS MPEG-4 v3'; } when /^div3$/i { return 'DivX3'; } when /^DIV(4|X)$/i { return 'DivX4'; } when /^DX50$/i { return 'DivX5'; } when /^XVID$/i { return 'XviD'; } when /^(avc1|H264)$/i { return 'H.264'; } when /^VP62$/i { return 'VP6'; } when /^RV40$/i { return 'rv40'; } default { return $_[0]; } } } sub audio_codec { given ($_[0]) { when /^1$/i { return 'PCM'; } when /^2$/i { return 'MS ADPCM'; } when /^85$/i { return 'MP3'; } when /^8192$/i { return 'AC-3'; } when /^353$/i { return 'WMA v2'; } when /^MP4A$/i { return 'AAC'; } when /^22127$/i { return 'Vorbis'; } default { return $_[0]; } } } # Convert ISO 639 language codes into full names sub code2lang { my $code = $_[0]; my $lang; $lang = code2language ($code, LOCALE_LANG_ALPHA_2); return $lang if defined $lang; $lang = code2language ($code, LOCALE_LANG_ALPHA_3); return $lang if defined $lang; return $code; } sub mkcast { no warnings 'uninitialized'; return $_->{name}. '::' .$_->{role}. '::imdb:' .$_->{id}; } # Try to find a matching entry in the database. sub getfile { my $crit = &iconv($_[0]); return $crit if defined $ignoredb_flag; my $SELECT = "SELECT id, imdbid, filename, title, year FROM $config{prefix}videodata WHERE "; if ($crit =~ /^[0-9]+$/) { $SELECT .= "id = $crit OR imdbid = 'imdb:$crit'"; } elsif ($crit =~ /.(avi|ogm|ogg|bin|mpe?g|ra?m|mov|asf|wmv|mkv)$/i) { $SELECT .= "filename = " .$dbh->quote (basename ($crit)); } else { $SELECT .= "title LIKE " .$dbh->quote ('%'.$crit.'%'); } my $res = $dbh->selectall_hashref( $SELECT, 'id' ) or die "Can't select: $!\n"; # We have a new file to add to the database if (scalar (keys $res) > 0) { my $answer; if (defined $force_update_flag) { die "Error: Non-single matching entry found. Try to refine your search.\n" if scalar (keys $res) > 1; $answer = $res->{(keys $res)[0]}->{id}; } else { print "Found " .scalar (keys $res). " matching entries:\n" or die "Can't print: $!"; my @options; foreach my $id (keys $res) { printf "%04d - ", $res->{$id}->{id} or die "Can't printf: $!"; print &iconv($res->{$id}->{title}. " (" .$res->{$id}->{year}. ")\n", 'utf8') or die "Can't print: $!"; push @options, sprintf ("%04d", $res->{$id}->{id}); } print "a - Ignore the matching entries, and add the new movie.\n" or die "Can't print: $!"; push @options, 'a'; for (my $i=0; $i<72; $i++) {print '=' or die "Can't print: $!"}; print "\n" or die "Can't print: $!"; $answer = &question ( \@options, "Choose an ID above to update:", $options[0] ); } $answer =~ s/^0+//; unless ($answer eq 'a') { $id = $res->{$answer}->{id}; my $imdbid = $res->{$answer}->{imdbid}; unless (defined $imdb{crit}) { warn "Warning: No imdbID found for ID $id. Try `--imdb'.\n" unless defined $imdbid; $imdbid =~ s/^imdb:// if defined $imdbid; $imdb{crit} = $imdbid; } undef $move_flag; return catfile( $config{videodir}, 'MOVIES', $res->{$answer}->{filename} ); } } # We have a new file to add to the database die "Error: No such file `" .$crit. "' (and I can't find a matching entry in the database).\n" unless -f $crit; return $crit; } sub keywords { my @ret; foreach my $k (@_) { if (lc $k eq 'imdb') { push @ret, qw/title subtitle language imdbid year imgurl director actors country plot genres rating istv/; } elsif (lc $k eq 'file') { push @ret, qw/filename filesize filedate video_codec audio_codec video_width video_height runtime language/; } else { die "Error: Unknown field `" .$k. "'.\n" unless grep { $_ eq $k } qw/title subtitle language imdbid year imgurl director actors country plot genres rating istv filename filesize filedate video_codec audio_codec video_width video_height runtime custom1 custom2 custom3 custom4/; push @ret, lc $k; } } return @ret; } sub include { # Returns 1 if the key should be included, 0 otherwise my $k = $_[0]; return 0 if grep {$_ eq $k} @exclude; return 0 if @only and not (grep {$_ eq $k} @only); return 1; } sub runIMDb { # Returns 1 if there is need to retrieve some data online, 0 otherwise foreach (qw/title subtitle language imdbid year imgurl director actors country plot genres rating istv custom1 custom2 custom3 custom4/) { return 1 if &include($_); } return 0; } sub runMplayer { # Returns 1 if there is need to run mplayer, 0 otherwise foreach ( qw/video_codec audio_codec video_width video_height runtime language custom1 custom2 custom3 custom4/) { return 1 if &include($_); } return 0; } # Ask a question interactively sub question { my ($options, $question, $default, $pdefault) = @_; my $answer; do { print "\a" or die "Can't print: $!"; # bell print $question ." [" or die "Can't print: $!"; if (defined $pdefault) { print $pdefault or die "Can't print: $!"; } else { print $default or die "Can't print: $!"; } print "] " or die "Can't print: $!"; $answer = $default; if ( <STDIN> =~ /(.+)/ ) { $answer = $1 }; undef $answer unless grep { $answer eq $_ } @$options; } until (defined $answer); return $answer; } # Yes/No question sub YNquestion { my ($question, $default) = @_; my $pdefault = "Y/n"; $pdefault = "y/N" if $default eq 'n'; return &question ( ['y','n'], $question, $default, $pdefault ); } # Convert to UTF-8 # (Strings from the database are in UTF-8, but are lacking the UTF-8 flag) sub iconv { my ($string, $enc) = @_; return unless defined $string; unless (Encode::is_utf8($string)) { my @encodings = qw/latin1 utf8/; @encodings = $enc if defined $enc; my $decoded; foreach my $enc (@encodings) { $decoded = Encode::decode( $enc, $string); next if $@ or not $decoded; last if utf8::valid($decoded); } $string = $decoded; } # The UTF-8 flag should be on now warn "Warning: Not a valid Unicode string: \"$string\"\n" unless utf8::valid($string); return $string; }