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 ),
                        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/^{{{//;
        $text =~ s/}}}$//;
        return '.pre' . $text . '.pre';
}

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 );

        $Rester->put_page( $name, { content => $body, date => $date });
        print "$name $date\n";
        foreach ( @tags ) {
                $Rester->put_pagetag( $name, $_ );
                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 );
                }
        }

}

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	15	date => convert_date( $date ),
89	dpavlin	18	attachments => $attachments,
90	dpavlin	14	};
91	dpavlin	13
92	dpavlin	11	$name =~ s,^.+/([^/]+)$,$1,;
93			push @page_names, $name;
94
95	dpavlin	5	},
96	dpavlin	18	no_chdir=>1,
97	dpavlin	5	}, shift @ARGV \|\| '.');
98
99	dpavlin	6	my @pages = ( keys %$page );
100	dpavlin	5
101	dpavlin	11	warn "found following pages: ", join(", ", @page_names),"\n";
102	dpavlin	5
103	dpavlin	11	my $page_link_re = '\b(' . join('\|', @page_names) . ')\b';
104
105	dpavlin	5	my $Rester = Socialtext::Resting->new(
106			username => 'tamtam',
107			password => 'import',
108			server => 'http://saturn.ffzg.hr/',
109	dpavlin	18	workspace => 'razmjenavjestina',
110	dpavlin	5	);
111			$Rester->put_workspacetag('TamTam');
112
113	dpavlin	15	sub convert_date {
114			my $date = shift;
115			# return time2str( $date );
116			return strftime('%F %T %z', gmtime( $date ));
117			}
118
119	dpavlin	5	sub header {
120			my $h = shift;
121			if ( $h =~ m/^(=+)\s+(.+?)\s+\1$/ ) {
122			my $level = length($1);
123			return "\n" . ( '^' x $level ) . " $2\n";
124			} else {
125	dpavlin	11	return $h;
126	dpavlin	5	}
127			}
128
129			sub surround {
130			my ( $with, $what ) = @_;
131			return $with . $what . $with;
132			}
133
134	dpavlin	12	sub pre {
135			my $text = shift;
136			$text =~ s/^{{{//;
137			$text =~ s/}}}$//;
138			return '.pre' . $text . '.pre';
139			}
140
141	dpavlin	14	sub convert_markup {
142			my $body = shift;
143	dpavlin	6
144	dpavlin	5	$body =~ s/\Q[[TableOfContents]]\E/{toc}/gs;
145			$body =~ s/\Q[[BR]]\E/\n/gs;
146			$body =~ s/$RE{balanced}{-begin => "= \|== \|=== \|==== \|===== \|===== "}{-end => " =\| ==\| ===\| ====\| ====="}{-keep}/header($1)/gse;
147			$body =~ s/''''(.+?)''''/surround('`',$1)/gse;
148			$body =~ s/'''(.+?)'''/surround('*',$1)/gse;
149			$body =~ s/''(.+?)''/surround('_',$1)/gse;
150	dpavlin	12	$body =~ s/$RE{balanced}{-begin => "{{{"}{-end => "}}}"}{-keep}/pre($1)/gse;
151	dpavlin	5
152	dpavlin	9	# fix bullets
153	dpavlin	7	$body =~ s/^\s+([\*])/$1/gm;
154
155	dpavlin	9	# fix links
156			$body =~ s/\["([^"]+)"\]/[$1]/gs;
157	dpavlin	10	$body =~ s,\[(http://\S+)\s+([^\]]+)\],"$2"<$1>,gs;
158			$body =~ s,\[(http://[^\]]+)\],$1,gs;
159	dpavlin	9
160	dpavlin	14	# fix hr
161			$body =~ s,(\S+)----,$1\n----,gs;
162			$body =~ s,----(\S+),----\n$1,gs;
163	dpavlin	5
164	dpavlin	18	# attachments
165	dpavlin	19	$body =~ s,\[attachment:([^\]]+)(gif\|png\|jpg\|jpeg)\],{image: $1$2},gis;
166	dpavlin	18	$body =~ s,\[attachment:([^\]]+)\],{file: $1},gs;
167
168	dpavlin	14	return $body;
169			}
170
171			my $count = 0;
172
173	dpavlin	18	my $m = File::MMagic::XS->new;
174
175	dpavlin	14	foreach my $name ( keys %$page ) {
176			last if $count++ == $max;
177
178			my $p = $page->{$name};
179	dpavlin	17
180			warn "## $name = ",dump( $p ) if $debug;
181
182	dpavlin	14	my $body = $p->{content} \|\| die "no content?";
183			my $date = $p->{date} \|\| die "no date?";
184
185	dpavlin	6	my @tags = ( 'TamTam' );
186	dpavlin	5
187	dpavlin	15	my $full_name = $name;
188
189	dpavlin	6	if ( $name =~ m!/! ) {
190			my @page_tags = split(m!/!, $name);
191	dpavlin	8	$name = pop @page_tags; # remove page name
192	dpavlin	6	push @tags, @page_tags;
193			}
194
195	dpavlin	14	# link named pages
196	dpavlin	16	$body =~ s,\b$page_link_re\b,[$1],gs;
197			$body =~ s,``,,gs;
198	dpavlin	14
199			$body .= qq{
200	dpavlin	22
201	dpavlin	14	----
202
203	dpavlin	20	"original"<http://www.razmjenavjestina.org/$full_name> {date: $date}
204	dpavlin	14	};
205
206			Encode::_utf8_off( $body );
207
208	dpavlin	18	$Rester->put_page( $name, { content => $body, date => $date });
209			print "$name $date\n";
210	dpavlin	6	foreach ( @tags ) {
211			$Rester->put_pagetag( $name, $_ );
212	dpavlin	18	print "+ tag $_\n";
213	dpavlin	6	}
214	dpavlin	23
215			if ( $attachments ) {
216			foreach my $a ( @{ $p->{attachments} } ) {
217			my $type = $m->get_mime( $a->{full_path} );
218			my $content = read_file( $a->{full_path} );
219			print "+ attachment ", $a->{name}," $type ", length($content), " bytes\n";
220			$Rester->post_attachment($name, $a->{name}, $content, $type );
221			}
222	dpavlin	18	}
223	dpavlin	6
224	dpavlin	5	}
225