| 1 | #!/usr/bin/perl -w |
|---|
| 2 | # |
|---|
| 3 | # $Id$ |
|---|
| 4 | # A simple tool for converting entries' keywords into tags for MT 3.3+ |
|---|
| 5 | # |
|---|
| 6 | # This software is provided as-is. You may use it for commercial or |
|---|
| 7 | # personal use. If you distribute it, please keep this notice intact. |
|---|
| 8 | # |
|---|
| 9 | # Copyright (c) 2006,2007 Hirotaka Ogawa |
|---|
| 10 | # |
|---|
| 11 | use strict; |
|---|
| 12 | sub BEGIN { |
|---|
| 13 | my $dir; |
|---|
| 14 | require File::Spec; |
|---|
| 15 | if (!($dir = $ENV{MT_HOME})) { |
|---|
| 16 | if ($0 =~ m!(.*[/\\])!) { |
|---|
| 17 | $dir = $1; |
|---|
| 18 | } else { |
|---|
| 19 | $dir = './'; |
|---|
| 20 | } |
|---|
| 21 | $ENV{MT_HOME} = $dir; |
|---|
| 22 | } |
|---|
| 23 | unshift @INC, File::Spec->catdir($dir, 'lib'); |
|---|
| 24 | unshift @INC, File::Spec->catdir($dir, 'extlib'); |
|---|
| 25 | } |
|---|
| 26 | |
|---|
| 27 | $| = 1; |
|---|
| 28 | print "Content-Type: text/html\n\n"; |
|---|
| 29 | print <<HTML; |
|---|
| 30 | <html> |
|---|
| 31 | <head><title>mt-keywords2tags</title></head> |
|---|
| 32 | <body> |
|---|
| 33 | <h1>mt-keywords2tags</h1> |
|---|
| 34 | |
|---|
| 35 | <pre> |
|---|
| 36 | HTML |
|---|
| 37 | |
|---|
| 38 | use MT; |
|---|
| 39 | use MT::Entry; |
|---|
| 40 | |
|---|
| 41 | my $mt = MT->new or die MT->errstr; |
|---|
| 42 | my $iter = MT::Entry->load_iter; |
|---|
| 43 | |
|---|
| 44 | while (my $e = $iter->()) { |
|---|
| 45 | next unless $e->keywords; |
|---|
| 46 | my @tags = split_tags($e->keywords, 1); |
|---|
| 47 | next unless scalar @tags; |
|---|
| 48 | $e->add_tags(@tags); |
|---|
| 49 | $e->save_tags; |
|---|
| 50 | print $e->id . ": " . join(', ', @tags) . "\n"; |
|---|
| 51 | } |
|---|
| 52 | |
|---|
| 53 | print <<HTML; |
|---|
| 54 | </pre> |
|---|
| 55 | <p><strong>Successfully added tags.</strong></p> |
|---|
| 56 | </body> |
|---|
| 57 | </html> |
|---|
| 58 | HTML |
|---|
| 59 | |
|---|
| 60 | sub split_tags { |
|---|
| 61 | my ($string, $case_sensitive) = @_; |
|---|
| 62 | return unless $string; |
|---|
| 63 | my @tags; |
|---|
| 64 | $string =~ s/\#.*$//g; |
|---|
| 65 | $string =~ s/(^\s+|\s+$)//g; |
|---|
| 66 | $string = lc $string unless $case_sensitive; |
|---|
| 67 | # $string =~ s/\[[^[]+\]//g; # uncomment this to discard [short title] |
|---|
| 68 | |
|---|
| 69 | if ($string =~ m/[;,|]/) { |
|---|
| 70 | # tags separated by non-whitespaces |
|---|
| 71 | while ($string =~ m/(\[[^]]+\]|"[^"]+"|'[^']+'|[^;,|]+)/g) { |
|---|
| 72 | my $tag = $1; |
|---|
| 73 | $tag =~ s/(^[\["'\s;,|]+|[\]"'\s;,|]+$)//g; |
|---|
| 74 | push @tags, $tag if $tag; |
|---|
| 75 | } |
|---|
| 76 | } else { |
|---|
| 77 | # tags separated by whitespaces |
|---|
| 78 | while ($string =~ m/(\[[^]]+\]|"[^"]+"|'[^']+'|[^\s]+)/g) { |
|---|
| 79 | my $tag = $1; |
|---|
| 80 | $tag =~ s/(^[\["'\s]+|[\]"'\s]+$)//g; |
|---|
| 81 | push @tags, $tag if $tag; |
|---|
| 82 | } |
|---|
| 83 | } |
|---|
| 84 | @tags; |
|---|
| 85 | } |
|---|