/[socialtext-import]/tamtam/tamtam2socialtext.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /tamtam/tamtam2socialtext.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (hide annotations)
Wed Dec 12 18:35:40 2007 UTC (16 years, 3 months ago) by dpavlin
File MIME type: text/plain
File size: 3408 byte(s)
links (again), remove `` which is used in TamTam to prevent
turning CamelCaps into links
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 5 use Data::Dump qw/dump/;
14    
15 dpavlin 11 my $max = 999;
16 dpavlin 6
17 dpavlin 5 my $page;
18 dpavlin 6 my $page_date;
19 dpavlin 5
20 dpavlin 9 my @page_names;
21    
22 dpavlin 5 find({
23     wanted => sub {
24     my $path = $File::Find::name;
25     return unless -f $path;
26 dpavlin 6
27 dpavlin 5 warn "# $path\n";
28     my $ref = XMLin( $path ) || die "can't open $path: $!";
29 dpavlin 6
30     my $name = $ref->{name} || die "no name in $path";
31 dpavlin 8
32     return if $name =~ m/^TamSystem/;
33    
34 dpavlin 14 my $date = $ref->{meta}->{LastModified}->{value};
35 dpavlin 6 if ( ! $date ) {
36     warn "SKIP: no LastModified in $path $name";
37     return;
38     }
39     my $data =
40     $ref->{widgets}->{widget}->{data} ||
41     $ref->{widgets}->{widget}->{Body}->{data} ||
42     die "no data in $path ",dump( $ref );
43    
44 dpavlin 14 $page->{ $name } = {
45     content => convert_markup( $data ),
46 dpavlin 15 date => convert_date( $date ),
47 dpavlin 14 };
48 dpavlin 13
49 dpavlin 11 # strip path from page name
50     $name =~ s,^.+/([^/]+)$,$1,;
51     push @page_names, $name;
52    
53 dpavlin 13 # warn dump( $ref );
54 dpavlin 5 },
55     }, shift @ARGV || '.');
56    
57 dpavlin 6 my @pages = ( keys %$page );
58 dpavlin 5
59 dpavlin 11 warn "found following pages: ", join(", ", @page_names),"\n";
60 dpavlin 5
61 dpavlin 11 my $page_link_re = '\b(' . join('|', @page_names) . ')\b';
62    
63 dpavlin 5 my $Rester = Socialtext::Resting->new(
64     username => 'tamtam',
65     password => 'import',
66     server => 'http://saturn.ffzg.hr/',
67     );
68     $Rester->workspace('razmjenavjestina');
69     $Rester->put_workspacetag('TamTam');
70    
71 dpavlin 15 sub convert_date {
72     my $date = shift;
73     # return time2str( $date );
74     return strftime('%F %T %z', gmtime( $date ));
75     }
76    
77 dpavlin 5 sub header {
78     my $h = shift;
79     if ( $h =~ m/^(=+)\s+(.+?)\s+\1$/ ) {
80     my $level = length($1);
81     return "\n" . ( '^' x $level ) . " $2\n";
82     } else {
83 dpavlin 11 return $h;
84 dpavlin 5 }
85     }
86    
87     sub surround {
88     my ( $with, $what ) = @_;
89     return $with . $what . $with;
90     }
91    
92 dpavlin 12 sub pre {
93     my $text = shift;
94     $text =~ s/^{{{//;
95     $text =~ s/}}}$//;
96     return '.pre' . $text . '.pre';
97     }
98    
99 dpavlin 14 sub convert_markup {
100     my $body = shift;
101 dpavlin 6
102 dpavlin 5 $body =~ s/\Q[[TableOfContents]]\E/{toc}/gs;
103     $body =~ s/\Q[[BR]]\E/\n/gs;
104     $body =~ s/$RE{balanced}{-begin => "= |== |=== |==== |===== |===== "}{-end => " =| ==| ===| ====| ====="}{-keep}/header($1)/gse;
105     $body =~ s/''''(.+?)''''/surround('`',$1)/gse;
106     $body =~ s/'''(.+?)'''/surround('*',$1)/gse;
107     $body =~ s/''(.+?)''/surround('_',$1)/gse;
108 dpavlin 12 $body =~ s/$RE{balanced}{-begin => "{{{"}{-end => "}}}"}{-keep}/pre($1)/gse;
109 dpavlin 5
110 dpavlin 9 # fix bullets
111 dpavlin 7 $body =~ s/^\s+([\*])/$1/gm;
112    
113 dpavlin 9 # fix links
114     $body =~ s/\["([^"]+)"\]/[$1]/gs;
115 dpavlin 10 $body =~ s,\[(http://\S+)\s+([^\]]+)\],"$2"<$1>,gs;
116     $body =~ s,\[(http://[^\]]+)\],$1,gs;
117 dpavlin 9
118 dpavlin 14 # fix hr
119     $body =~ s,(\S+)----,$1\n----,gs;
120     $body =~ s,----(\S+),----\n$1,gs;
121 dpavlin 5
122 dpavlin 14 return $body;
123     }
124    
125     my $count = 0;
126    
127     foreach my $name ( keys %$page ) {
128     last if $count++ == $max;
129    
130     my $p = $page->{$name};
131     my $body = $p->{content} || die "no content?";
132     my $date = $p->{date} || die "no date?";
133    
134 dpavlin 6 my @tags = ( 'TamTam' );
135 dpavlin 5
136 dpavlin 15 my $full_name = $name;
137    
138 dpavlin 6 if ( $name =~ m!/! ) {
139     my @page_tags = split(m!/!, $name);
140 dpavlin 8 $name = pop @page_tags; # remove page name
141 dpavlin 6 push @tags, @page_tags;
142     }
143    
144 dpavlin 14 # link named pages
145 dpavlin 16 $body =~ s,\b$page_link_re\b,[$1],gs;
146     $body =~ s,``,,gs;
147 dpavlin 14
148     $body .= qq{
149     ----
150    
151 dpavlin 15 Original sa http://www.razmjenavjestina.org/$full_name zadnja promjena {date: $date}
152 dpavlin 14 };
153    
154     Encode::_utf8_off( $body );
155    
156 dpavlin 6 $Rester->put_page( $name, {
157     content => $body,
158     date => $date,
159     });
160 dpavlin 14 print "+ $name $date\n";
161 dpavlin 6 foreach ( @tags ) {
162     $Rester->put_pagetag( $name, $_ );
163     print "+ $name [$_]\n";
164     }
165    
166 dpavlin 5 }
167    

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26