socialtext-import/tamtam/tamtam2socialtext.pl

#!/usr/bin/perl

use warnings;
use strict;

use XML::Simple;
use File::Find;
use Regexp::Common qw/balanced/;
use Socialtext::Resting;
use Encode;
use HTTP::Date;
use POSIX qw/strftime/;
use File::Slurp;
use File::MMagic::XS;
use Getopt::Long;
use Data::Dump qw/dump/;

my $debug = 0;
my $max = 999;
my $attachments = 0;

GetOptions(
        'debug+' => \$debug,
        'max=i' => \$max,
        'attachments' => \$attachments,
);

my $page;
my $page_date;

my @page_names;

print "Importing $max pages", $attachments ? " with attachments" : "", "...\n";

find({
        wanted => sub {
                my $path = $File::Find::name;
                return unless -f $path;

                warn "+ $path\n";
                my $ref = XMLin( $path,
                        KeyAttr => {
                                'attachment' => '+name',
                                'meta' => 'name',
                        },
                        ForceArray => [ 'attachment', 'meta', 'widget' ],
                ) || die "can't open $path: $!";

                warn "## $path = ",dump( $ref ) if $debug;

                my $name = $ref->{name} || die "no name in $path";

                return if $name =~ m/^TamSystem/;

                my $date =  $ref->{meta}->{LastModified}->{value};
                if ( ! $date ) {
                        warn "SKIP: no LastModified in $path $name";
                        return;
                }

                my $data;

                foreach my $w ( @{ $ref->{widgets}->{widget} } ) {

                        warn "## w = ",dump( $w ) if $debug;

                        $data .= "\n----\n" if $data;
                        $data .= $w->{data} || die "no data?";
                }

                my $attachments;

                if ( my $a = $ref->{attachment} ) {
                        foreach my $name ( keys %$a ) {
                                my $full_path = $path;
                                $full_path =~ s,pages/,attachments/,;
                                $full_path .= '.' . $name;
                                die "$full_path doesn't exist" unless -e $full_path;
                                push @$attachments, {
                                        full_path => $full_path,
                                        name => ( $name || $a->{$name}->{desc} || 'noname' ),
                                };
                        }
                }

                $page->{ $name } = {
                        content => convert_markup( $data ),
                        original => $data,
                        date => convert_date( $date ),
                        attachments => $attachments,
                };

                $name =~ s,^.+/([^/]+)$,$1,;
                push @page_names, $name;

        },
        no_chdir=>1,
}, shift @ARGV || '.');

my @pages = ( keys %$page );

warn "found following pages: ", join(", ", @page_names),"\n";

my $page_link_re = '\b(' . join('|', @page_names) . ')\b';

my $Rester = Socialtext::Resting->new(
        username => 'tamtam',
        password => 'import',
        server   => 'http://saturn.ffzg.hr/',
        workspace => 'razmjenavjestina',
);
$Rester->put_workspacetag('TamTam');

sub convert_date {
        my $date = shift;
#       return time2str( $date );
        return strftime('%F %T %z', gmtime( $date ));
}

sub header {
        my $h = shift;
        if ( $h =~ m/^(=+)\s+(.+?)\s+\1$/ ) {
                my $level = length($1);
                return "\n" . ( '^' x $level ) . " $2\n";
        } else {
                return $h;
        }
}

sub surround {
        my ( $with, $what ) = @_;
        return $with . $what . $with;
}

sub pre {
        my $text = shift;
        $text =~ s/^{{{\s*//s;
        $text =~ s/\s*}}}$//s;
        return "\n.pre\n" . $text . "\n.pre\n";
}

sub convert_markup {
        my $body = shift;

        $body =~ s/\Q[[TableOfContents]]\E/{toc}/gs;
        $body =~ s/\Q[[BR]]\E/\n/gs;
        $body =~ s/$RE{balanced}{-begin => "= |== |=== |==== |===== |===== "}{-end => " =| ==| ===| ====| ====="}{-keep}/header($1)/gse;
        $body =~ s/''''(.+?)''''/surround('`',$1)/gse;
        $body =~ s/'''(.+?)'''/surround('*',$1)/gse;
        $body =~ s/''(.+?)''/surround('_',$1)/gse;
        $body =~ s/$RE{balanced}{-begin => "{{{"}{-end => "}}}"}{-keep}/pre($1)/gse;

        # fix bullets
        $body =~ s/^\s+([\*])/$1/gm;

        # fix links
        $body =~ s/\["([^"]+)"\]/[$1]/gs;
        $body =~ s,\[(http://\S+)\s+([^\]]+)\],"$2"<$1>,gs;
        $body =~ s,\[(http://[^\]]+)\],$1,gs;

        # fix hr
        $body =~ s,(\S+)----,$1\n----,gs;
        $body =~ s,----(\S+),----\n$1,gs;

        # attachments
        $body =~ s,\[attachment:([^\]]+)(gif|png|jpg|jpeg)\],{image: $1$2},gis;
        $body =~ s,\[attachment:([^\]]+)\],{file: $1},gs;

        return $body;
}

my $count = 0;

my $m = File::MMagic::XS->new;

foreach my $name ( keys %$page ) {
        last if $count++ == $max;

        my $p = $page->{$name};

        warn "## $name = ",dump( $p ) if $debug;

        my $body = $p->{content} || die "no content?";
        my $date = $p->{date} || die "no date?";

        my @tags = ( 'TamTam' );

        my $full_name = $name;

        if ( $name =~ m!/! ) {
                my @page_tags = split(m!/!, $name);
                $name = pop @page_tags; # remove page name
                push @tags, @page_tags;
        }

        # link named pages
        $body =~ s,\b$page_link_re\b,[$1],gs;
        $body =~ s,``,,gs;

        $body .= qq{

----

"original"<http://www.razmjenavjestina.org/$full_name> {date: $date}
};

        Encode::_utf8_off( $body );

        print "$name $date\n";

        # original markup
        $Rester->put_page( $name, { content => $p->{original}, date => $date });

        foreach ( @tags ) {
                $Rester->put_pagetag( $name, $_, { date => $date } );
                print "+ tag $_\n";
        }

        if ( $attachments ) {
                foreach my $a ( @{ $p->{attachments} } ) {
                        my $type = $m->get_mime( $a->{full_path} );
                        my $content = read_file( $a->{full_path} );
                        print "+ attachment ", $a->{name}," $type ", length($content), " bytes\n";
                        $Rester->post_attachment($name, $a->{name}, $content, $type );
                }
        }

        # converted page
        $Rester->put_page( $name, { content => $body, date => $date });

}

1	dpavlin	5	#!/usr/bin/perl
2
3			use warnings;
4			use strict;
5
6			use XML::Simple;
7			use File::Find;
8			use Regexp::Common qw/balanced/;
9			use Socialtext::Resting;
10			use Encode;
11	dpavlin	6	use HTTP::Date;
12	dpavlin	15	use POSIX qw/strftime/;
13	dpavlin	18	use File::Slurp;
14			use File::MMagic::XS;
15	dpavlin	21	use Getopt::Long;
16	dpavlin	5	use Data::Dump qw/dump/;
17
18	dpavlin	18	my $debug = 0;
19	dpavlin	11	my $max = 999;
20	dpavlin	23	my $attachments = 0;
21	dpavlin	6
22	dpavlin	21	GetOptions(
23			'debug+' => \$debug,
24			'max=i' => \$max,
25	dpavlin	23	'attachments' => \$attachments,
26	dpavlin	21	);
27
28	dpavlin	5	my $page;
29	dpavlin	6	my $page_date;
30	dpavlin	5
31	dpavlin	9	my @page_names;
32
33	dpavlin	24	print "Importing $max pages", $attachments ? " with attachments" : "", "...\n";
34	dpavlin	18
35	dpavlin	5	find({
36			wanted => sub {
37			my $path = $File::Find::name;
38			return unless -f $path;
39	dpavlin	6
40	dpavlin	18	warn "+ $path\n";
41			my $ref = XMLin( $path,
42			KeyAttr => {
43			'attachment' => '+name',
44			'meta' => 'name',
45			},
46	dpavlin	22	ForceArray => [ 'attachment', 'meta', 'widget' ],
47	dpavlin	18	) \|\| die "can't open $path: $!";
48	dpavlin	6
49	dpavlin	18	warn "## $path = ",dump( $ref ) if $debug;
50
51	dpavlin	6	my $name = $ref->{name} \|\| die "no name in $path";
52	dpavlin	8
53			return if $name =~ m/^TamSystem/;
54
55	dpavlin	14	my $date = $ref->{meta}->{LastModified}->{value};
56	dpavlin	6	if ( ! $date ) {
57			warn "SKIP: no LastModified in $path $name";
58			return;
59			}
60	dpavlin	17
61	dpavlin	18	my $data;
62	dpavlin	17
63	dpavlin	18	foreach my $w ( @{ $ref->{widgets}->{widget} } ) {
64	dpavlin	6
65	dpavlin	18	warn "## w = ",dump( $w ) if $debug;
66	dpavlin	17
67	dpavlin	18	$data .= "\n----\n" if $data;
68			$data .= $w->{data} \|\| die "no data?";
69			}
70
71			my $attachments;
72
73			if ( my $a = $ref->{attachment} ) {
74			foreach my $name ( keys %$a ) {
75			my $full_path = $path;
76			$full_path =~ s,pages/,attachments/,;
77			$full_path .= '.' . $name;
78			die "$full_path doesn't exist" unless -e $full_path;
79			push @$attachments, {
80			full_path => $full_path,
81			name => ( $name \|\| $a->{$name}->{desc} \|\| 'noname' ),
82			};
83			}
84			}
85
86	dpavlin	14	$page->{ $name } = {
87			content => convert_markup( $data ),
88	dpavlin	26	original => $data,
89	dpavlin	15	date => convert_date( $date ),
90	dpavlin	18	attachments => $attachments,
91	dpavlin	14	};
92	dpavlin	13
93	dpavlin	11	$name =~ s,^.+/([^/]+)$,$1,;
94			push @page_names, $name;
95
96	dpavlin	5	},
97	dpavlin	18	no_chdir=>1,
98	dpavlin	5	}, shift @ARGV \|\| '.');
99
100	dpavlin	6	my @pages = ( keys %$page );
101	dpavlin	5
102	dpavlin	11	warn "found following pages: ", join(", ", @page_names),"\n";
103	dpavlin	5
104	dpavlin	11	my $page_link_re = '\b(' . join('\|', @page_names) . ')\b';
105
106	dpavlin	5	my $Rester = Socialtext::Resting->new(
107			username => 'tamtam',
108			password => 'import',
109			server => 'http://saturn.ffzg.hr/',
110	dpavlin	18	workspace => 'razmjenavjestina',
111	dpavlin	5	);
112			$Rester->put_workspacetag('TamTam');
113
114	dpavlin	15	sub convert_date {
115			my $date = shift;
116			# return time2str( $date );
117			return strftime('%F %T %z', gmtime( $date ));
118			}
119
120	dpavlin	5	sub header {
121			my $h = shift;
122			if ( $h =~ m/^(=+)\s+(.+?)\s+\1$/ ) {
123			my $level = length($1);
124			return "\n" . ( '^' x $level ) . " $2\n";
125			} else {
126	dpavlin	11	return $h;
127	dpavlin	5	}
128			}
129
130			sub surround {
131			my ( $with, $what ) = @_;
132			return $with . $what . $with;
133			}
134
135	dpavlin	12	sub pre {
136			my $text = shift;
137	dpavlin	25	$text =~ s/^{{{\s*//s;
138			$text =~ s/\s*}}}$//s;
139			return "\n.pre\n" . $text . "\n.pre\n";
140	dpavlin	12	}
141
142	dpavlin	14	sub convert_markup {
143			my $body = shift;
144	dpavlin	6
145	dpavlin	5	$body =~ s/\Q[[TableOfContents]]\E/{toc}/gs;
146			$body =~ s/\Q[[BR]]\E/\n/gs;
147			$body =~ s/$RE{balanced}{-begin => "= \|== \|=== \|==== \|===== \|===== "}{-end => " =\| ==\| ===\| ====\| ====="}{-keep}/header($1)/gse;
148			$body =~ s/''''(.+?)''''/surround('`',$1)/gse;
149			$body =~ s/'''(.+?)'''/surround('*',$1)/gse;
150			$body =~ s/''(.+?)''/surround('_',$1)/gse;
151	dpavlin	12	$body =~ s/$RE{balanced}{-begin => "{{{"}{-end => "}}}"}{-keep}/pre($1)/gse;
152	dpavlin	5
153	dpavlin	9	# fix bullets
154	dpavlin	7	$body =~ s/^\s+([\*])/$1/gm;
155
156	dpavlin	9	# fix links
157			$body =~ s/\["([^"]+)"\]/[$1]/gs;
158	dpavlin	10	$body =~ s,\[(http://\S+)\s+([^\]]+)\],"$2"<$1>,gs;
159			$body =~ s,\[(http://[^\]]+)\],$1,gs;
160	dpavlin	9
161	dpavlin	14	# fix hr
162			$body =~ s,(\S+)----,$1\n----,gs;
163			$body =~ s,----(\S+),----\n$1,gs;
164	dpavlin	5
165	dpavlin	18	# attachments
166	dpavlin	19	$body =~ s,\[attachment:([^\]]+)(gif\|png\|jpg\|jpeg)\],{image: $1$2},gis;
167	dpavlin	18	$body =~ s,\[attachment:([^\]]+)\],{file: $1},gs;
168
169	dpavlin	14	return $body;
170			}
171
172			my $count = 0;
173
174	dpavlin	18	my $m = File::MMagic::XS->new;
175
176	dpavlin	14	foreach my $name ( keys %$page ) {
177			last if $count++ == $max;
178
179			my $p = $page->{$name};
180	dpavlin	17
181			warn "## $name = ",dump( $p ) if $debug;
182
183	dpavlin	14	my $body = $p->{content} \|\| die "no content?";
184			my $date = $p->{date} \|\| die "no date?";
185
186	dpavlin	6	my @tags = ( 'TamTam' );
187	dpavlin	5
188	dpavlin	15	my $full_name = $name;
189
190	dpavlin	6	if ( $name =~ m!/! ) {
191			my @page_tags = split(m!/!, $name);
192	dpavlin	8	$name = pop @page_tags; # remove page name
193	dpavlin	6	push @tags, @page_tags;
194			}
195
196	dpavlin	14	# link named pages
197	dpavlin	16	$body =~ s,\b$page_link_re\b,[$1],gs;
198			$body =~ s,``,,gs;
199	dpavlin	14
200			$body .= qq{
201	dpavlin	22
202	dpavlin	14	----
203
204	dpavlin	20	"original"<http://www.razmjenavjestina.org/$full_name> {date: $date}
205	dpavlin	14	};
206
207			Encode::_utf8_off( $body );
208
209	dpavlin	18	print "$name $date\n";
210	dpavlin	26
211			# original markup
212			$Rester->put_page( $name, { content => $p->{original}, date => $date });
213
214	dpavlin	6	foreach ( @tags ) {
215	dpavlin	26	$Rester->put_pagetag( $name, $_, { date => $date } );
216	dpavlin	18	print "+ tag $_\n";
217	dpavlin	6	}
218	dpavlin	23
219			if ( $attachments ) {
220			foreach my $a ( @{ $p->{attachments} } ) {
221			my $type = $m->get_mime( $a->{full_path} );
222			my $content = read_file( $a->{full_path} );
223			print "+ attachment ", $a->{name}," $type ", length($content), " bytes\n";
224			$Rester->post_attachment($name, $a->{name}, $content, $type );
225			}
226	dpavlin	18	}
227	dpavlin	6
228	dpavlin	26	# converted page
229			$Rester->put_page( $name, { content => $body, date => $date });
230
231	dpavlin	5	}
232